Released DG*5.3*1052 SEQ #935 Extracted from mail message **KIDS**:DG*5.3*1052^ **INSTALL NAME** DG*5.3*1052 "BLD",12302,0) DG*5.3*1052^REGISTRATION^0^3211027^y "BLD",12302,1,0) ^^13^13^3211027^ "BLD",12302,1,1,0) Patch DG*5.3*1052 addresses 3 issues. "BLD",12302,1,2,0) "BLD",12302,1,3,0) 1. User reported an UNDEFINED ODS+2^DGDIS error after entering '^' "BLD",12302,1,4,0) at the 'Select the type of disposition:' prompt in the Disposition "BLD",12302,1,5,0) an Application [DG DISPOSITION APPLICATION] option. "BLD",12302,1,6,0) "BLD",12302,1,7,0) 2. User reported an UNDEFINED ANS+15^DGDIS error after entering "BLD",12302,1,8,0) '^' at one of multiple possible prompts in the Disposition an "BLD",12302,1,9,0) Application [DG DISPOSITION APPLICATION] option. "BLD",12302,1,10,0) "BLD",12302,1,11,0) 3. An update to the Collateral Patient Register [DG COLLATERAL "BLD",12302,1,12,0) PATIENT] option to add a 'WARNING' message to notify users that "BLD",12302,1,13,0) they could potentially be editing the identity of a patient. "BLD",12302,4,0) ^9.64PA^^ "BLD",12302,6) 7 "BLD",12302,6.3) 7 "BLD",12302,"KRN",0) ^9.67PA^1.5^25 "BLD",12302,"KRN",.4,0) .4 "BLD",12302,"KRN",.401,0) .401 "BLD",12302,"KRN",.402,0) .402 "BLD",12302,"KRN",.403,0) .403 "BLD",12302,"KRN",.5,0) .5 "BLD",12302,"KRN",.84,0) .84 "BLD",12302,"KRN",1.5,0) 1.5 "BLD",12302,"KRN",1.6,0) 1.6 "BLD",12302,"KRN",1.61,0) 1.61 "BLD",12302,"KRN",1.62,0) 1.62 "BLD",12302,"KRN",3.6,0) 3.6 "BLD",12302,"KRN",3.8,0) 3.8 "BLD",12302,"KRN",9.2,0) 9.2 "BLD",12302,"KRN",9.8,0) 9.8 "BLD",12302,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",12302,"KRN",9.8,"NM",1,0) DGCOL^^0^B33658039 "BLD",12302,"KRN",9.8,"NM",2,0) DGDIS^^0^B42798500 "BLD",12302,"KRN",9.8,"NM","B","DGCOL",1) "BLD",12302,"KRN",9.8,"NM","B","DGDIS",2) "BLD",12302,"KRN",19,0) 19 "BLD",12302,"KRN",19.1,0) 19.1 "BLD",12302,"KRN",101,0) 101 "BLD",12302,"KRN",409.61,0) 409.61 "BLD",12302,"KRN",771,0) 771 "BLD",12302,"KRN",779.2,0) 779.2 "BLD",12302,"KRN",870,0) 870 "BLD",12302,"KRN",8989.51,0) 8989.51 "BLD",12302,"KRN",8989.52,0) 8989.52 "BLD",12302,"KRN",8993,0) 8993 "BLD",12302,"KRN",8994,0) 8994 "BLD",12302,"KRN","B",.4,.4) "BLD",12302,"KRN","B",.401,.401) "BLD",12302,"KRN","B",.402,.402) "BLD",12302,"KRN","B",.403,.403) "BLD",12302,"KRN","B",.5,.5) "BLD",12302,"KRN","B",.84,.84) "BLD",12302,"KRN","B",1.5,1.5) "BLD",12302,"KRN","B",1.6,1.6) "BLD",12302,"KRN","B",1.61,1.61) "BLD",12302,"KRN","B",1.62,1.62) "BLD",12302,"KRN","B",3.6,3.6) "BLD",12302,"KRN","B",3.8,3.8) "BLD",12302,"KRN","B",9.2,9.2) "BLD",12302,"KRN","B",9.8,9.8) "BLD",12302,"KRN","B",19,19) "BLD",12302,"KRN","B",19.1,19.1) "BLD",12302,"KRN","B",101,101) "BLD",12302,"KRN","B",409.61,409.61) "BLD",12302,"KRN","B",771,771) "BLD",12302,"KRN","B",779.2,779.2) "BLD",12302,"KRN","B",870,870) "BLD",12302,"KRN","B",8989.51,8989.51) "BLD",12302,"KRN","B",8989.52,8989.52) "BLD",12302,"KRN","B",8993,8993) "BLD",12302,"KRN","B",8994,8994) "BLD",12302,"QDEF") ^^^^^^^^^^YES "BLD",12302,"QUES",0) ^9.62^^ "BLD",12302,"REQB",0) ^9.611^1^1 "BLD",12302,"REQB",1,0) DG*5.3*1027^1 "BLD",12302,"REQB","B","DG*5.3*1027",1) "MBREQ") 0 "PKG",5,-1) 1^1 "PKG",5,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",5,22,0) ^9.49I^1^1 "PKG",5,22,1,0) 5.3^2930813 "PKG",5,22,1,"PAH",1,0) 1052^3211027 "PKG",5,22,1,"PAH",1,1,0) ^^13^13^3211027 "PKG",5,22,1,"PAH",1,1,1,0) Patch DG*5.3*1052 addresses 3 issues. "PKG",5,22,1,"PAH",1,1,2,0) "PKG",5,22,1,"PAH",1,1,3,0) 1. User reported an UNDEFINED ODS+2^DGDIS error after entering '^' "PKG",5,22,1,"PAH",1,1,4,0) at the 'Select the type of disposition:' prompt in the Disposition "PKG",5,22,1,"PAH",1,1,5,0) an Application [DG DISPOSITION APPLICATION] option. "PKG",5,22,1,"PAH",1,1,6,0) "PKG",5,22,1,"PAH",1,1,7,0) 2. User reported an UNDEFINED ANS+15^DGDIS error after entering "PKG",5,22,1,"PAH",1,1,8,0) '^' at one of multiple possible prompts in the Disposition an "PKG",5,22,1,"PAH",1,1,9,0) Application [DG DISPOSITION APPLICATION] option. "PKG",5,22,1,"PAH",1,1,10,0) "PKG",5,22,1,"PAH",1,1,11,0) 3. An update to the Collateral Patient Register [DG COLLATERAL "PKG",5,22,1,"PAH",1,1,12,0) PATIENT] option to add a 'WARNING' message to notify users that "PKG",5,22,1,"PAH",1,1,13,0) they could potentially be editing the identity of a patient. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 2 "RTN","DGCOL") 0^1^B33658039^B29923636 "RTN","DGCOL",1,0) DGCOL ;ALB/MRL,ARF,RN - COLLATERAL PATIENT ENTRY-EDIT ; 04 MAY 87 "RTN","DGCOL",2,0) ;;5.3;Registration;**2,23,32,993,1023,1027,1052**;Aug 13, 1993;Build 7 "RTN","DGCOL",3,0) 1 K DFN W !! S DGDIR=$S($D(DGDIR):DGDIR,1:1),DIC="^DPT(",DIC(0)="AEQML",DIC("DR")=".03;.09;.02;.3601;1901///^S X=""N"";391///^S X=""COLLATERAL"";.361///^S X=""COLLATERAL OF VET."";.323///^S X=""OTHER NON-VETERANS"";" "RTN","DGCOL",4,0) S DLAYGO=2 D ^DIC I Y'>0 S DGDIR=0 K DLAYGO G Q "RTN","DGCOL",5,0) S DFN=+Y,DGVET=$S('$D(^DPT(DFN,"VET")):0,^("VET")="Y":1,1:0) I '$P(Y,"^",3),DGVET,'DGDIR G Q "RTN","DGCOL",6,0) EN S DGDIR=$S($D(DGDIR):DGDIR,1:0) G Q:'$D(DFN),VET:DGVET "RTN","DGCOL",7,0) S DGELG=$S('$D(^DPT(DFN,.36)):1,'$D(^DIC(8,+^(.36),0)):1,$P(^(0),"^",9)'=13:0,1:1),DGPS=$S('$D(^DPT(DFN,.32)):1,'$D(^DIC(21,+$P(^(.32),"^",3),0)):1,$P(^(0),"^",1)'["OTHER NON-VET":0,1:1) G:('DGELG!'DGPS) ECPS K DGELG,DGPS D EN^DGRPD "RTN","DGCOL",8,0) N DGEANS S DGEANS=$$WARNING "RTN","DGCOL",9,0) I $G(DGEANS)'=1 G 1 "RTN","DGCOL",10,0) I $D(DGRPOUT) K DGRPOUT G 1 "RTN","DGCOL",11,0) S (Y,DA)=DFN,DR="[DGCOLLATERAL]",DGNOCOL=0,DIE="^DPT(" D ^DIE G Q:DGNOCOL!'$D(^DPT(DFN,0)) I '$D(DGCOLV) W !!,"COLLATERAL VETERAN SPONSOR NAME IS UNSPECIFIED!!",*7 G EN "RTN","DGCOL",12,0) S DGAD=$S($D(^DPT(DFN,.11)):$P(^(.11),"^",1,12),1:""),DGAD1=$S($D(^DPT(+DGCOLV,.11)):$P(^(.11),"^",1,12),1:""),C=0 W !!,"APPLICANT ADDRESS DATA",?45,"SPONSOR ADDRESS DATA",!,"----------------------",?45,"--------------------" "RTN","DGCOL",13,0) S C=0,P=1,X=DGAD D AD S C=0,P=2,X=DGAD1 D AD F I=0:0 S I=$O(AD(I)) Q:'I W !,$P(AD(I),"^",1),?45,$P(AD(I),"^",2) "RTN","DGCOL",14,0) S DGPHON=$S($D(^DPT(DFN,.13)):$P(^(.13),"^",1),1:""),$P(DGPHON,"^",2)=$S($D(^DPT(DGCOLV,.13)):$P(^(.13),"^",1),1:"") "RTN","DGCOL",15,0) W !!,"Phone: ",$S($P(DGPHON,"^",1)]"":$P(DGPHON,"^",1),1:"UNKNOWN"),?45,"Phone: ",$S($P(DGPHON,"^",2)]"":$P(DGPHON,"^",2),1:"UNKNOWN") "RTN","DGCOL",16,0) W !!,"SPONSOR: ",$P(^DPT(DGCOLV,0),"^",1),", ",$E($P(^(0),"^",9),1,3),"-",$E($P(^(0),"^",9),4,5),"-",$E($P(^(0),"^",9),6,10) "RTN","DGCOL",17,0) D ENRRO ;DG*5.3*993 - Ask for SELF-SUPPORTED REGISTRATION ONLY REASON "RTN","DGCOL",18,0) ASK W !!,"DO YOU WISH TO EDIT COLLATERAL INFORMATION" S %=2 D YN^DICN G Q:%=2!(%=-1) I %=0 W !,"ENTER 'Y'ES OR 'N'O" G ASK "RTN","DGCOL",19,0) H W !!,"SHOULD COLLATERAL PATIENT ADDRESS DATA BE SAME AS SPONSOR'S" S %=2 D YN^DICN I %>0 S DGADED=(%-1) G ED "RTN","DGCOL",20,0) G Q:%=-1 W !!,"Y - To stuff in sponsor's address data.",!,"N - To edit collateral address data",!,"^ - To QUIT." G H "RTN","DGCOL",21,0) ED I DGADED S DR=".3601;.111;S:X']"""" Y=.114;.112;S:X']"""" Y=.114;.113:.115;.1112;.117;.131;",DIE="^DPT(",(DA,Y)=DFN D ^DIE G Q "RTN","DGCOL",22,0) ;S DGADD=$S($D(^DPT(DFN,.11)):^(.11),1:""),DGADD=$P(DGAD1,"^",1,12)_"^"_$P(DGADD,"^",13,999),^DPT(DFN,.11)=DGADD,$P(^DPT(DFN,.13),"^",1)=$P(DGPHON,"^",2) W !!,"Sponsor address data entered..." G Q "RTN","DGCOL",23,0) S DGADD=$S($D(^DPT(DFN,.11)):^(.11),1:""),DGADD=$P(DGAD1,"^",1,12)_"^^^^"_$$GET1^DIQ(2,DGCOLV,.121)_"^^"_$P(DGADD,"^",18),$P(DGADD,"^",7)=$$GET1^DIQ(2,DGCOLV,.117) D W !!,"Sponsor address data entered..." G Q "RTN","DGCOL",24,0) .S DIE="^DPT(",DA=DFN,DR=".111///^S X=$P(DGADD,U);.112///^S X=$P(DGADD,U,2);.113///^S X=$P(DGADD,U,3);.114///^S X=$P(DGADD,U,4);.115///^S X=$P(DGADD,U,5);.116///^S X=$P(DGADD,U,6);.117///^S X=$P(DGADD,U,7)" D ^DIE "RTN","DGCOL",25,0) .S DIE="^DPT(",DA=DFN,DR=".1171///^S X=$P(DGADD,U,8);.1172///^S X=$P(DGADD,U,9);.1173///^S X=$P(DGADD,U,10);.118///^S X=$P(DGADD,U,13);.119///^S X=$P(DGADD,U,14);.12///^S X=$P(DGADD,U,15);.121///^S X=$P(DGADD,U,16)" D ^DIE "RTN","DGCOL",26,0) .S DIE="^DPT(",DA=DFN,DR=";.1118///^S X=$P(DGADD,U,18);.131///^S X=$P(DGPHON,U,2)" D ^DIE "RTN","DGCOL",27,0) .Q "RTN","DGCOL",28,0) AD F I=1:1:5,12,7 I $P(X,"^",I)]"" D "RTN","DGCOL",29,0) .S D=$P(X,"^",I),C=C+1 "RTN","DGCOL",30,0) .S:(I=12)&($L(D)>5) D=$E(D,1,5)_"-"_$E(D,6,20) "RTN","DGCOL",31,0) .S $P(AD(C),"^",P)=D S:I=5 $P(AD(C),"^",P)=$S($D(^DIC(5,+D,0)):$P(^(0),"^",1),1:"STATE UNKNOWN") I I=7 S $P(AD(C),"^",P)=$S($D(^DIC(5,+$P(X,"^",5),1,+D,0)):$P(^(0),"^",1),1:"UNKNOWN") "RTN","DGCOL",32,0) Q "RTN","DGCOL",33,0) ENRRO ;DG*5.3*993 - Ask for SELF-SUPPORTED REGISTRATION ONLY REASON "RTN","DGCOL",34,0) N DGENRODT,DGENRRSN,DGENSRCE,DGNOW,DIR,DGCURR,X,Y,DGKEY,DGREQNAME,DGENSTAT,DGWSHTOEN,DGRESP,DTOUT,DUOUT "RTN","DGCOL",35,0) ;DG*5.3.1027 - Modifications to input logic of field .15 (REGISTRATION ONLY REASON) of the 27.11 (PATIENT ENROLLMENT) file "RTN","DGCOL",36,0) ;W !!,"SELF-REPORTED REGISTRATION ONLY REASON" ;DG*5.3*1027 - not needed - replaced with code below "RTN","DGCOL",37,0) W ! ;DG*5.3*1027 ;spacing only "RTN","DGCOL",38,0) S DGENRRSN="" "RTN","DGCOL",39,0) S DGCURR=$$FINDCUR^DGENA(DFN) "RTN","DGCOL",40,0) ; DG*5.3*1027 If DO YOU WISH TO ENROLL field in PATIENT (#2) file is YES AND "RTN","DGCOL",41,0) ; no current enrollment record AND "RTN","DGCOL",42,0) ; The patient is unknown to ES, prompt for REGISTRATION ONLY REASON "RTN","DGCOL",43,0) ; Supported DBIA #2701: The supported DBIA is used to access MPI "RTN","DGCOL",44,0) ; APIs to retrieve ICN, determine if ICN "RTN","DGCOL",45,0) ; is local and if site is LST. "RTN","DGCOL",46,0) S DGKEY=$$GETICN^MPIF001(DFN) "RTN","DGCOL",47,0) S DGREQNAME="VistAData" "RTN","DGCOL",48,0) S DGRESP=0 "RTN","DGCOL",49,0) I $P(DGKEY,"^",1)'=-1 S DGRESP=$$EN^DGREGEEWS(DGKEY,DGREQNAME,.DGENSTAT,.DGWSHTOEN) "RTN","DGCOL",50,0) I 'DGCURR,+DGRESP=0 F D Q:DGENRRSN "RTN","DGCOL",51,0) . K DIR "RTN","DGCOL",52,0) . S DIR("A")="SELF-REPORTED REGISTRATION ONLY REASON: " "RTN","DGCOL",53,0) . S DIR(0)="27.11,.15,AO" "RTN","DGCOL",54,0) . D ^DIR "RTN","DGCOL",55,0) . I $D(DTOUT)!$D(DUOUT) S Y="" "RTN","DGCOL",56,0) . S DGENRRSN=+Y "RTN","DGCOL",57,0) . I 'DGENRRSN W !,"This is a required field.",! ;end DG*5.3*1027 changes "RTN","DGCOL",58,0) I DGENRRSN S DGNOW=$$NOW^XLFDT(),DGENRODT=DGNOW,DGENSRCE=1 D REGONLY^DGEN(DFN) "RTN","DGCOL",59,0) Q "RTN","DGCOL",60,0) ;DG*5.3*993 End of mods "RTN","DGCOL",61,0) VET W !!,*7,"Patient is a veteran and therefore should not be classified utilizing this",!,"option. If this veteran has Other Entitled Eligibilities please insure that " "RTN","DGCOL",62,0) W !,"the appropriate APPOINTMENT TYPE is selected at the time you make the",!,"appointment." G Q "RTN","DGCOL",63,0) ECPS K DGELG,DGPS W !!,*7,"Patient already has an eligibility code or period of service on file and",!,"therefore should not be classified using this option. If this veteran",!,"has Other Entitled Eligibilities, please insure that the" "RTN","DGCOL",64,0) W " appropriate",!,"APPOINTMENT TYPE is selected at the time you make the appointment." "RTN","DGCOL",65,0) Q K %,Y,DGVET,DIE,DIC,DGCOLV,DR,X,I,DGNOCOL,DA,AD,C,P,D,DGADD,I1,DGAD,DGAD1,DGADED,DGPHON G:DGDIR 1 K DGDIR S:$D(DFN) Y=DFN Q "RTN","DGCOL",66,0) WARNING() ;Add WARNING message to notify user of possible patient identity edits "RTN","DGCOL",67,0) W !!,?25,"**WARNING!!**" "RTN","DGCOL",68,0) W !!,"The edits you are about to make may potentially change the identity of" "RTN","DGCOL",69,0) W !,"this patient. Please verify that you have selected the correct patient" "RTN","DGCOL",70,0) W !,"and ensure that supporting documentation exists for these changes." "RTN","DGCOL",71,0) N DIR,Y "RTN","DGCOL",72,0) S DIR(0)="Y",DIR("A")="Do you wish to continue and save your edits" "RTN","DGCOL",73,0) S DIR("B")="NO" D ^DIR "RTN","DGCOL",74,0) Q Y "RTN","DGDIS") 0^2^B42798500^B42266493 "RTN","DGDIS",1,0) DGDIS ;ALB/JDS,RN - DISPOSITION A REGISTRATION ; 8/6/04 3:17pm "RTN","DGDIS",2,0) ;;5.3;Registration;**108,121,161,151,459,604,993,1031,1027,1052**;Aug 13, 1993;Build 7 "RTN","DGDIS",3,0) ; "RTN","DGDIS",4,0) D LO^DGUTL "RTN","DGDIS",5,0) GETL S L=^DG(43,1,0),DISL=+$P(L,"^",7) S:DISL=0 DISL=24 N SDISHDL "RTN","DGDIS",6,0) FIND W !! S DIC("A")="Disposition PATIENT: ",DIC="^DPT(",DIC(0)="AEQMZ",DIC("S")="I $D(^DPT(""ADA"",1,+Y))" D ^DIC K DIC("S"),DIC("A") G Q:Y'>0 S (DA,DFN,DGDFN)=+Y "RTN","DGDIS",7,0) S I=+$O(^DPT(DA,"DIS",0)),L=$S($D(^(I,0)):^(0),1:""),(DA,DFN1,DGDFN1)=I,SDL=L ;I $P(L,"^",6)?7N.E!(L="") W !!,"There are no open registrations to disposition for this patient.",!!,*7,*7 K DA,DFN1 G FIND "RTN","DGDIS",8,0) DP W !!,"LOG DATE",?20,"TYPE OF BENEFIT APPLIED FOR",! F I=1:1:47 W "-" "RTN","DGDIS",9,0) S L2=";"_$P(^DD(2.101,2,0),"^",3),L3=";"_$P(L,"^",3)_":" "RTN","DGDIS",10,0) W !,$$FMTE^XLFDT($E($P(L,U),1,12),"5Z"),?20,$P($P(L2,L3,2),";",1) "RTN","DGDIS",11,0) S DGODSND=L "RTN","DGDIS",12,0) ANS ; "RTN","DGDIS",13,0) ;** DG*5.3*108; Eligibility Code and Period of Service Checks follow "RTN","DGDIS",14,0) ;**DG*5.3*993; Decoupling project code for register only "RTN","DGDIS",15,0) N STATUS,DGENRYN,DGINELIG S STATUS=$$STATUS^DGENA($G(DFN)) ; DG*5.3*993 "RTN","DGDIS",16,0) I $$GET^DGENPTA($G(DFN),.DGENPTA) S DGINELIG=$G(DGENPTA("INELDATE")) "RTN","DGDIS",17,0) I STATUS=25 S DGENRYN=0 "RTN","DGDIS",18,0) N SEEN S SEEN=$$GET1^DIQ(2.101,DFN1_","_DFN_",",7,"I") "RTN","DGDIS",19,0) ; DG*5.3*1031 - added "+"SEEN so NULL value for SEEN is treated as a ZERO "RTN","DGDIS",20,0) I '$G(DGINELIG),STATUS=25 D "RTN","DGDIS",21,0) . I +SEEN=0 W !! S DR="1//2;2;2.1;13;5//NOW;D CHT^DGDIS;8"_$S(DUZ'="":";9////"_DUZ,1:""),DIE="^DPT("_DFN_",""DIS"",",DA(1)=DFN,DP=2.101 D ^DIE I $S('$D(^DPT(DFN,"DIS",DA,0)):1,'$P(^(0),"^",6):1,1:0) G DEL "RTN","DGDIS",22,0) . I SEEN=1 W !! S DR="1//0;2;2.1;13;5//NOW;D CHT^DGDIS;8"_$S(DUZ'="":";9////"_DUZ,1:""),DIE="^DPT("_DFN_",""DIS"",",DA(1)=DFN,DP=2.101 D ^DIE I $S('$D(^DPT(DFN,"DIS",DA,0)):1,'$P(^(0),"^",6):1,1:0) G DEL "RTN","DGDIS",23,0) I STATUS'=25 W !! S DR="1;2;2.1;13;5//NOW;D CHT^DGDIS;8"_$S(DUZ'="":";9////"_DUZ,1:""),DIE="^DPT("_DFN_",""DIS"",",DA(1)=DFN,DP=2.101 D ^DIE I $S('$D(^DPT(DFN,"DIS",DA,0)):1,'$P(^(0),"^",6):1,1:0) G DEL ; Original code "RTN","DGDIS",24,0) I $G(DGINELIG),STATUS=25 D "RTN","DGDIS",25,0) . W !! S DR="1;2;2.1;13;5//NOW;D CHT^DGDIS;8"_$S(DUZ'="":";9////"_DUZ,1:""),DIE="^DPT("_DFN_",""DIS"",",DA(1)=DFN,DP=2.101 D ^DIE I $S('$D(^DPT(DFN,"DIS",DA,0)):1,'$P(^(0),"^",6):1,1:0) G DEL "RTN","DGDIS",26,0) N DGPOSX,DGELIGX,DGSTRX "RTN","DGDIS",27,0) I '$D(DFN) D Q Q "RTN","DGDIS",28,0) S DGELIGX=$S('$D(^DPT(DFN,.36)):1,$P(^(.36),"^",1)']"":1,1:0) "RTN","DGDIS",29,0) S DGPOSX=$S('$D(^DPT(DFN,.32)):1,$P(^(.32),"^",3)']"":1,1:0) "RTN","DGDIS",30,0) I (DGELIGX)&(DGPOSX) W !!,"Primary Eligibility Code and Period of Service are unspecified." K DGPOSX,DGELIGX,DGSTRX G DEL "RTN","DGDIS",31,0) I (DGELIGX)&('DGPOSX) W !!,"Primary Eligibility Code is unspecified." K DGPOSX,DGELIGX,DGSTRX G DEL "RTN","DGDIS",32,0) I ('DGELIGX)&(DGPOSX) W !!,"Period of Service is unspecified." K DGPOSX,DGELIGX,DGSTRX G DEL "RTN","DGDIS",33,0) ;S DGXXXD=0 D EL^DGREGE "RTN","DGDIS",34,0) DISP ;**DG*5.3*993; Decoupling project "RTN","DGDIS",35,0) ; DG*5.3*1027 - Made code changes to prevent duplicate prompt "Select the type of disposition:" "RTN","DGDIS",36,0) I '$G(DGINELIG),STATUS=25 D "RTN","DGDIS",37,0) . ; DG*5.3*1031 - added "+"SEEN so NULL value for SEEN is treated as a ZERO "RTN","DGDIS",38,0) . I +SEEN=0 D "RTN","DGDIS",39,0) . . W ! S DIC="^DIC(37,",DIC(0)="AEQMZ",DIC("A")="Select the type of disposition: ",DIC("S")="I '$P(^(0),""^"",10)" "RTN","DGDIS",40,0) . . S DIC("B")="CANCEL WITHOUT EXAM" D ^DIC K DIC("A"),DIC("B") I Y'>0 G DEL:X?1"^".E W !!,"A disposition must be entered to continue.",!!,*7,*7 G DISP "RTN","DGDIS",41,0) . I SEEN=1 D "RTN","DGDIS",42,0) . . W ! S DIC="^DIC(37,",DIC(0)="AEQMZ",DIC("A")="Select the type of disposition: ",DIC("S")="I '$P(^(0),""^"",10)" "RTN","DGDIS",43,0) . . D ^DIC K DIC("A"),DIC("B") I Y'>0 G DEL:X?1"^".E W !!,"A disposition must be entered to continue.",!!,*7,*7 G DISP "RTN","DGDIS",44,0) I STATUS'=25 W ! S DIC="^DIC(37,",DIC(0)="AEQMZ",DIC("A")="Select the type of disposition: ",DIC("S")="I '$P(^(0),""^"",10)" D ^DIC K DIC("A"),DIC("B") I Y'>0 G DEL:X?1"^".E W !!,"A disposition must be entered to continue.",!!,*7,*7 G DISP "RTN","DGDIS",45,0) I $G(DGINELIG),STATUS=25 D "RTN","DGDIS",46,0) . W ! S DIC="^DIC(37,",DIC(0)="AEQMZ",DIC("A")="Select the type of disposition: ",DIC("S")="I '$P(^(0),""^"",10)" D ^DIC K DIC("A"),DIC("B") I Y'>0 G DEL:X?1"^".E W !!,"A disposition must be entered to continue.",!!,*7,*7 G DISP "RTN","DGDIS",47,0) I '$D(Y) D Q Q "RTN","DGDIS",48,0) D ODS "RTN","DGDIS",49,0) S DR="" I $P(Y(0),"^",1)["INELIG" S DIE("NO^")="",DR="2.1;" "RTN","DGDIS",50,0) S DR=DR_"S:'DGODS Y=6;11500.01////1;11500.02////^S X=$S(DGODSE>0:DGODSE,1:"""");" "RTN","DGDIS",51,0) S DR=DR_"6///"_(+Y),DISP=+Y,DA=DFN1,DP=2.101,DA(1)=DFN D ^DIE K DIE("NO^") S DDT=$S($D(^DPT(DFN,"DIS",DA,0)):^(0),1:""),DGDIV=+$P(DDT,"^",4),DDT=$P(DDT,"^",6) S:'DGDIV DGDIV="" "RTN","DGDIS",52,0) I $P(^DG(43,1,0),U,30) S %ZIS="N",IOP="HOME" D ^%ZIS I $D(IOS),IOS,$D(^%ZIS(1,+IOS,99)),$D(^%ZIS(1,+^(99),0)) S Y=$P(^(0),U,1),DGIO(10)=Y "RTN","DGDIS",53,0) S X=$S($D(^DG(40.8,+DGDIV,"DEV")):^("DEV"),1:"1^1^1") S:'$D(DGIO(10)) DGIO(10)=$S($P(X,U,1)]"":$P(X,U,1),1:1) "RTN","DGDIS",54,0) S DFN=DGDFN,DFN1=DGDFN1,DGXXXD=0,DIE="^DPT("_DFN_",""DIS""," D EL^DGREGE "RTN","DGDIS",55,0) D MT "RTN","DGDIS",56,0) D EN1^DGEN(DFN) ;enrollment "RTN","DGDIS",57,0) W !!,"***** Registration dispositioned *****",!!,*7 "RTN","DGDIS",58,0) D VALIDATE(DFN,DFN1) ; -- call c/o validator "RTN","DGDIS",59,0) D ACT "RTN","DGDIS",60,0) K DGDFN1,DGDOM,DGHEM,DGKAAS,DGL,DGNHCU,DGW,MASD,MASDEV,PARA,POP "RTN","DGDIS",61,0) DONE D Q G FIND "RTN","DGDIS",62,0) ; "RTN","DGDIS",63,0) Q K %H,%Y,C,D0,D1,DG1,DGA1,DGDFN1,DGL,DGT,DQ,I1,SD321,SDDIV,SDL,VA,VAROOT,Z,DGDFN,DIC,DGIO,DDT,DISP,DGDIV,DA,DR,DFN,DFN1,L,I,Y,X,DIE,DIC,DP "RTN","DGDIS",64,0) K DGODS,DGODSND,SDISDEL Q "RTN","DGDIS",65,0) ; "RTN","DGDIS",66,0) CHT S L=^DPT(DA(1),"DIS",DA,0),DGL=0,L2=+$P(L,"^",6),(L1,X)=+L D H^%DTC S LL1=%H,X=L2 D H^%DTC S LL2=%H "RTN","DGDIS",67,0) S X1=L1#1*10000,X2=L2#1*10000 S:LL2-LL1 X2=X2+(LL2-LL1*2400\1) S X3=X2\100-(X1\100),X2=X2#100,X1=X1#100 S:X1'