Released DG*5.3*604 SEQ #542 Extracted from mail message **KIDS**:DG*5.3*604^ **INSTALL NAME** DG*5.3*604 "BLD",5692,0) DG*5.3*604^REGISTRATION^0^3040809^y "BLD",5692,1,0) ^^2^2^3040809^ "BLD",5692,1,1,0) Patient Safety issue regarding iens with decimals; "BLD",5692,1,2,0) routines with undefined variables "BLD",5692,4,0) ^9.64PA^^ "BLD",5692,"INIT") "BLD",5692,"KRN",0) ^9.67PA^8989.52^19 "BLD",5692,"KRN",.4,0) .4 "BLD",5692,"KRN",.401,0) .401 "BLD",5692,"KRN",.402,0) .402 "BLD",5692,"KRN",.403,0) .403 "BLD",5692,"KRN",.5,0) .5 "BLD",5692,"KRN",.84,0) .84 "BLD",5692,"KRN",3.6,0) 3.6 "BLD",5692,"KRN",3.8,0) 3.8 "BLD",5692,"KRN",9.2,0) 9.2 "BLD",5692,"KRN",9.8,0) 9.8 "BLD",5692,"KRN",9.8,"NM",0) ^9.68A^3^3 "BLD",5692,"KRN",9.8,"NM",1,0) DGDIS^^0^B24999461 "BLD",5692,"KRN",9.8,"NM",2,0) VAFHPURG^^0^B8187336 "BLD",5692,"KRN",9.8,"NM",3,0) DG53P604^^0^B10476695 "BLD",5692,"KRN",9.8,"NM","B","DG53P604",3) "BLD",5692,"KRN",9.8,"NM","B","DGDIS",1) "BLD",5692,"KRN",9.8,"NM","B","VAFHPURG",2) "BLD",5692,"KRN",19,0) 19 "BLD",5692,"KRN",19.1,0) 19.1 "BLD",5692,"KRN",101,0) 101 "BLD",5692,"KRN",409.61,0) 409.61 "BLD",5692,"KRN",771,0) 771 "BLD",5692,"KRN",870,0) 870 "BLD",5692,"KRN",8989.51,0) 8989.51 "BLD",5692,"KRN",8989.52,0) 8989.52 "BLD",5692,"KRN",8994,0) 8994 "BLD",5692,"KRN","B",.4,.4) "BLD",5692,"KRN","B",.401,.401) "BLD",5692,"KRN","B",.402,.402) "BLD",5692,"KRN","B",.403,.403) "BLD",5692,"KRN","B",.5,.5) "BLD",5692,"KRN","B",.84,.84) "BLD",5692,"KRN","B",3.6,3.6) "BLD",5692,"KRN","B",3.8,3.8) "BLD",5692,"KRN","B",9.2,9.2) "BLD",5692,"KRN","B",9.8,9.8) "BLD",5692,"KRN","B",19,19) "BLD",5692,"KRN","B",19.1,19.1) "BLD",5692,"KRN","B",101,101) "BLD",5692,"KRN","B",409.61,409.61) "BLD",5692,"KRN","B",771,771) "BLD",5692,"KRN","B",870,870) "BLD",5692,"KRN","B",8989.51,8989.51) "BLD",5692,"KRN","B",8989.52,8989.52) "BLD",5692,"KRN","B",8994,8994) "BLD",5692,"QUES",0) ^9.62^^ "BLD",5692,"REQB",0) ^9.611^2^2 "BLD",5692,"REQB",1,0) DG*5.3*459^1 "BLD",5692,"REQB",2,0) DG*5.3*530^1 "BLD",5692,"REQB","B","DG*5.3*459",1) "BLD",5692,"REQB","B","DG*5.3*530",2) "MBREQ") 0 "PKG",5,-1) 1^1 "PKG",5,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",5,20,0) ^9.402P^^ "PKG",5,22,0) ^9.49I^1^1 "PKG",5,22,1,0) 5.3^2930813 "PKG",5,22,1,"PAH",1,0) 604^3040809^100850 "PKG",5,22,1,"PAH",1,1,0) ^^2^2^3040809 "PKG",5,22,1,"PAH",1,1,1,0) Patient Safety issue regarding iens with decimals; "PKG",5,22,1,"PAH",1,1,2,0) routines with undefined variables "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") YES "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") YES "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") 3 "RTN","DG53P604") 0^3^B10476695 "RTN","DG53P604",1,0) DG53P604 ;BAY/JAT - Patient File Updat; 6/7/04 7:13pm ; 8/7/04 7:51pm "RTN","DG53P604",2,0) ;;5.3;Registration;**604**;Aug 13,1993 "RTN","DG53P604",3,0) ; "RTN","DG53P604",4,0) REPORT ; "RTN","DG53P604",5,0) N X1,X2 "RTN","DG53P604",6,0) K ^XTMP("DG53P604",$J) "RTN","DG53P604",7,0) S X1=DT,X2=90 D C^%DTC "RTN","DG53P604",8,0) S ^XTMP("DG53P604",$J,0)=X_"^"_DT_"^Patient file iens w/decimals" "RTN","DG53P604",9,0) I $$DEVICE() D ENTER "RTN","DG53P604",10,0) Q "RTN","DG53P604",11,0) ; "RTN","DG53P604",12,0) ENTER ; "RTN","DG53P604",13,0) D READ "RTN","DG53P604",14,0) D ^%ZISC "RTN","DG53P604",15,0) I $D(ZTQUEUED) S ZTREQ="@" "RTN","DG53P604",16,0) Q "RTN","DG53P604",17,0) DEVICE() ; "RTN","DG53P604",18,0) ;Description: allows the user to select a device. "RTN","DG53P604",19,0) ; "RTN","DG53P604",20,0) ;Output: "RTN","DG53P604",21,0) ; Function Value - Returns 0 if the user decides not to print or to "RTN","DG53P604",22,0) ; queue the report, 1 otherwise. "RTN","DG53P604",23,0) ; "RTN","DG53P604",24,0) N OK,IOP,POP,%ZIS "RTN","DG53P604",25,0) S OK=1 "RTN","DG53P604",26,0) S %ZIS="MQ" "RTN","DG53P604",27,0) D ^%ZIS "RTN","DG53P604",28,0) S:POP OK=0 "RTN","DG53P604",29,0) D:OK&$D(IO("Q")) "RTN","DG53P604",30,0) .N ZTRTN,ZTDESC,ZTSKM,ZTREQ,ZTSTOP "RTN","DG53P604",31,0) .S ZTRTN="ENTER^DG53P604",ZTDESC="Patient file iens w/decimals" "RTN","DG53P604",32,0) .D ^%ZTLOAD "RTN","DG53P604",33,0) .W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED") "RTN","DG53P604",34,0) .D HOME^%ZIS "RTN","DG53P604",35,0) .S OK=0 "RTN","DG53P604",36,0) Q OK "RTN","DG53P604",37,0) ; "RTN","DG53P604",38,0) READ ; "RTN","DG53P604",39,0) ; "RTN","DG53P604",40,0) N DFN,COUNT,DGSSN,DGWHEN,DGDTCARE "RTN","DG53P604",41,0) S (COUNT,DFN)=0 "RTN","DG53P604",42,0) F S DFN=$O(^DPT(DFN)) Q:'DFN D "RTN","DG53P604",43,0) .; merged record "RTN","DG53P604",44,0) .I $D(^DPT(DFN,-9)) Q "RTN","DG53P604",45,0) .; in process of being merged "RTN","DG53P604",46,0) .I $P($G(^DPT(DFN,0)),U)["MERGING INTO" Q "RTN","DG53P604",47,0) .I DFN'["." Q "RTN","DG53P604",48,0) .I $D(^DPT(DFN,0)) D "RTN","DG53P604",49,0) ..S DGSSN=$P($G(^DPT(DFN,0)),U,9) "RTN","DG53P604",50,0) ..S DGWHEN=$P($G(^DPT(DFN,0)),U,16) "RTN","DG53P604",51,0) ..S DGDTCARE=$P($G(^DPT(DFN,1010.15)),U) "RTN","DG53P604",52,0) ..S COUNT=COUNT+1 "RTN","DG53P604",53,0) ..S ^XTMP("DG53P604",$J,DFN)=DGSSN_"^"_DGWHEN_"^"_DGDTCARE "RTN","DG53P604",54,0) ; "RTN","DG53P604",55,0) D PRINT "RTN","DG53P604",56,0) Q "RTN","DG53P604",57,0) ; "RTN","DG53P604",58,0) PRINT ; "RTN","DG53P604",59,0) U IO "RTN","DG53P604",60,0) N DGDDT,DGQUIT,DGPG "RTN","DG53P604",61,0) S DGDDT=$$FMTE^XLFDT($$NOW^XLFDT,"D") "RTN","DG53P604",62,0) S (DGQUIT,DGPG)=0 "RTN","DG53P604",63,0) D HEAD "RTN","DG53P604",64,0) I '$G(COUNT) D Q "RTN","DG53P604",65,0) .W !!!,?20,"*** No records to report ***" "RTN","DG53P604",66,0) W !!,"*** COUNT OF PATIENT RECORDS:",COUNT," ***",!! "RTN","DG53P604",67,0) S DFN=0 "RTN","DG53P604",68,0) F S DFN=$O(^XTMP("DG53P604",$J,DFN)) Q:'DFN D Q:DGQUIT "RTN","DG53P604",69,0) .I $Y>(IOSL-4) D HEAD "RTN","DG53P604",70,0) .S DGSSN=$P($G(^XTMP("DG53P604",$J,DFN)),U) "RTN","DG53P604",71,0) .S DGWHEN=$P($G(^XTMP("DG53P604",$J,DFN)),U,2) "RTN","DG53P604",72,0) .S DGWHEN=$$FMTE^XLFDT(DGWHEN,"D") "RTN","DG53P604",73,0) .S DGDTCARE=$P($G(^XTMP("DG53P604",$J,DFN)),U,3) "RTN","DG53P604",74,0) .S DGDTCARE=$$FMTE^XLFDT(DGDTCARE,"D") "RTN","DG53P604",75,0) .W ?2,DFN,?20,DGSSN,?37,DGWHEN,?56,DGDTCARE,! "RTN","DG53P604",76,0) ; "RTN","DG53P604",77,0) I DGQUIT W:$D(ZTQUEUED) !!,"Report stopped at user's request" Q "RTN","DG53P604",78,0) I $G(DGPG)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1 "RTN","DG53P604",79,0) I $D(ZTQUEUED) S ZTREQ="@" "RTN","DG53P604",80,0) Q "RTN","DG53P604",81,0) ; "RTN","DG53P604",82,0) HEAD ; "RTN","DG53P604",83,0) I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,DGQUIT)=1 Q "RTN","DG53P604",84,0) I $G(DGPG)>0,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 DGQUIT=1 "RTN","DG53P604",85,0) Q:DGQUIT "RTN","DG53P604",86,0) S DGPG=$G(DGPG)+1 "RTN","DG53P604",87,0) W @IOF,!,DGDDT,?15,"DG*5.3*604 Patient File iens w/decimals",?70,"Page:",$J(DGPG,5),! K X S $P(X,"-",81)="" W X,! "RTN","DG53P604",88,0) W ! "RTN","DG53P604",89,0) W !,?2,"DFN",?23,"SSN",?37,"Date Record Created",?58,"Most Recent Care Date",! "RTN","DG53P604",90,0) S $P(X,"-",81)="" W X,! "RTN","DG53P604",91,0) Q "RTN","DGDIS") 0^1^B24999461 "RTN","DGDIS",1,0) DGDIS ;ALB/JDS - DISPOSITION A REGISTRATION ; 8/6/04 3:17pm "RTN","DGDIS",2,0) ;;5.3;Registration;**108,121,161,151,459,604**;Aug 13, 1993 "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) 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",15,0) N DGPOSX,DGELIGX,DGSTRX "RTN","DGDIS",16,0) S DGELIGX=$S('$D(^DPT(DFN,.36)):1,$P(^(.36),"^",1)']"":1,1:0) "RTN","DGDIS",17,0) S DGPOSX=$S('$D(^DPT(DFN,.32)):1,$P(^(.32),"^",3)']"":1,1:0) "RTN","DGDIS",18,0) I (DGELIGX)&(DGPOSX) W !!,"Primary Eligibility Code and Period of Service are unspecified." K DGPOSX,DGELIGX,DGSTRX G DEL "RTN","DGDIS",19,0) I (DGELIGX)&('DGPOSX) W !!,"Primary Eligibility Code is unspecified." K DGPOSX,DGELIGX,DGSTRX G DEL "RTN","DGDIS",20,0) I ('DGELIGX)&(DGPOSX) W !!,"Period of Service is unspecified." K DGPOSX,DGELIGX,DGSTRX G DEL "RTN","DGDIS",21,0) ;S DGXXXD=0 D EL^DGREGE "RTN","DGDIS",22,0) DISP 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",23,0) D ODS "RTN","DGDIS",24,0) S DR="" I $P(Y(0),"^",1)["INELIG" S DIE("NO^")="",DR="2.1;" "RTN","DGDIS",25,0) S DR=DR_"S:'DGODS Y=6;11500.01////1;11500.02////^S X=$S(DGODSE>0:DGODSE,1:"""");" "RTN","DGDIS",26,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",27,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",28,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",29,0) S DFN=DGDFN,DFN1=DGDFN1,DGXXXD=0,DIE="^DPT("_DFN_",""DIS""," D EL^DGREGE "RTN","DGDIS",30,0) D MT "RTN","DGDIS",31,0) D EN1^DGEN(DFN) ;enrollment "RTN","DGDIS",32,0) W !!,"***** Registration dispositioned *****",!!,*7 "RTN","DGDIS",33,0) D VALIDATE(DFN,DFN1) ; -- call c/o validator "RTN","DGDIS",34,0) D ACT "RTN","DGDIS",35,0) K DGDFN1,DGDOM,DGHEM,DGKAAS,DGL,DGNHCU,DGW,MASD,MASDEV,PARA,POP "RTN","DGDIS",36,0) DONE D Q G FIND "RTN","DGDIS",37,0) ; "RTN","DGDIS",38,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",39,0) K DGODS,DGODSND,SDISDEL Q "RTN","DGDIS",40,0) ; "RTN","DGDIS",41,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",42,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'VAFHEDT!(VAFHX="") D DELETE "RTN","VAFHPURG",26,0) D EXIT "RTN","VAFHPURG",27,0) ;D CLEAN "RTN","VAFHPURG",28,0) ;D EXIT "RTN","VAFHPURG",29,0) Q "RTN","VAFHPURG",30,0) ; "RTN","VAFHPURG",31,0) DELETE ;this will do that actual deletion. "RTN","VAFHPURG",32,0) ; "RTN","VAFHPURG",33,0) N DA,DIK,EVENT,MOVE,OUT "RTN","VAFHPURG",34,0) S DA=0 "RTN","VAFHPURG",35,0) F S DA=+$O(^VAT(391.71,"B",VAFHX,DA)) Q:('DA) D "RTN","VAFHPURG",36,0) .;DG*604 - skip if no zero node "RTN","VAFHPURG",37,0) .I '$D(^VAT(391.71,DA,0)) Q "RTN","VAFHPURG",38,0) .;don't delete inpatient event records before discharge "RTN","VAFHPURG",39,0) .S EVENT=+$P(^VAT(391.71,DA,0),U,4) "RTN","VAFHPURG",40,0) .I EVENT=1 D Q:OUT "RTN","VAFHPURG",41,0) ..S OUT=0 "RTN","VAFHPURG",42,0) ..S MOVE=$P(^VAT(391.71,DA,0),U,5) "RTN","VAFHPURG",43,0) ..Q:MOVE'["DGPM" "RTN","VAFHPURG",44,0) ..I $P($G(^DGPM(+MOVE,0)),U,17)="" S OUT=1 "RTN","VAFHPURG",45,0) .;don't delete if requires transmission "RTN","VAFHPURG",46,0) .Q:$D(^VAT(391.71,"AXMIT",EVENT,DA)) "RTN","VAFHPURG",47,0) .;delete "RTN","VAFHPURG",48,0) .S DIK="^VAT(391.71," "RTN","VAFHPURG",49,0) .D ^DIK "RTN","VAFHPURG",50,0) .W:'$D(ZTQUEUED) "." "RTN","VAFHPURG",51,0) Q "RTN","VAFHPURG",52,0) ; "RTN","VAFHPURG",53,0) EXIT ;kills variables "RTN","VAFHPURG",54,0) K VAFHX,VAFHEDT,X,Y "RTN","VAFHPURG",55,0) Q "RTN","VAFHPURG",56,0) ; "RTN","VAFHPURG",57,0) KIL1 K X,Y,%DT "RTN","VAFHPURG",58,0) Q "RTN","VAFHPURG",59,0) ; "RTN","VAFHPURG",60,0) CLEAN ; delete entries with invalid event pointer, ie doesn't exist "RTN","VAFHPURG",61,0) ; CLEAN^VAFHPURG may be run directly from programmer mode "RTN","VAFHPURG",62,0) ; "RTN","VAFHPURG",63,0) I '$D(ZTQUEUED) W !!,"All ADT/HL7 PIVOT entries with invalid EVENT POINTERS will be deleted",! "RTN","VAFHPURG",64,0) D DT^DICRW "RTN","VAFHPURG",65,0) N EVENTVP,GLOBAL,GLOBALR,NODE "RTN","VAFHPURG",66,0) S VAFHX=0 "RTN","VAFHPURG",67,0) F S VAFHX=$O(^VAT(391.71,VAFHX)) Q:'VAFHX S NODE=$G(^(VAFHX,0)) DO "RTN","VAFHPURG",68,0) .; if no .01 date/time "RTN","VAFHPURG",69,0) . I 'NODE D REMOVE Q "RTN","VAFHPURG",70,0) . S EVENTVP=$P(NODE,"^",5) "RTN","VAFHPURG",71,0) .; if event pointer has no pointer "RTN","VAFHPURG",72,0) . I 'EVENTVP D REMOVE Q "RTN","VAFHPURG",73,0) . S GLOBAL=$P(EVENTVP,";",2) "RTN","VAFHPURG",74,0) .; if event pointer has no variable "RTN","VAFHPURG",75,0) . I GLOBAL="" D REMOVE Q "RTN","VAFHPURG",76,0) .; if variable not distributed "RTN","VAFHPURG",77,0) . I "DPT(DGPM(SCE("'[GLOBAL D REMOVE Q "RTN","VAFHPURG",78,0) . S GLOBALR="^"_GLOBAL_+EVENTVP_")" "RTN","VAFHPURG",79,0) .; "RTN","VAFHPURG",80,0) . I $D(@GLOBALR) Q "RTN","VAFHPURG",81,0) .; if no pointed to eentr delete this oney "RTN","VAFHPURG",82,0) . D REMOVE Q "RTN","VAFHPURG",83,0) Q "RTN","VAFHPURG",84,0) ; "RTN","VAFHPURG",85,0) ;either the pointed to entry doesn't exist or the VP entry is invalid "RTN","VAFHPURG",86,0) ;so delete it "RTN","VAFHPURG",87,0) REMOVE S DA=VAFHX "RTN","VAFHPURG",88,0) S DIK="^VAT(391.71," "RTN","VAFHPURG",89,0) D ^DIK "RTN","VAFHPURG",90,0) I '$D(ZTQUEUED) W "," "RTN","VAFHPURG",91,0) K DIK,DA "RTN","VAFHPURG",92,0) Q "VER") 8.0^22 **END** **END**