DG53528P ;ALB/ERC - COMBAT VET PRE & POSTINSTALLS ;7/22/03
;;5.3;Registration;**528**; Aug 13, 1993
;
PRE ;add 5 new entries to the INCONSISTENT DATA ELEMENTS file (#38.6)
;to alert users that critical dates for the determination of CV
;status are either imprecise or missing
;
;first check to see if patch already installed - if so do not
;add these new entries
I $$PATCH^XPDUTL("DG*5.3*528") Q
N DGK,DGWP
K XPDABORT
F DGK=67:1:71 I $D(^DGIN(38.6,DGK)) Q:$G(XPDABORT)=2 D
. D BMES^XPDUTL(" ** Internal Entry # "_DGK_" already exists in file #38.6, contact NVS **")
. S XPDABORT=2
I $G(XPDABORT)'=2 D
. D BMES^XPDUTL(" >> Adding new entries into the INCONSISTENT DATA ELEMENTS file (#38.6).")
. D ADD
Q
ADD ;set up FDA arrays for the addition of new entries in 38.6
N DG,DG67,DG68,DG69,DG70,DG71,DGERR,DGFDA,DGIEN,DGWORD,DGX
D SET
F DGX=DG67,DG68,DG69,DG70,DG71 D
. K DGFDA
. S DGFDA(38.6,"+1,",.01)=$P(DGX,U)
. S DGFDA(38.6,"+1,",2)=$P(DGX,U,2)
. S DGFDA(38.6,"+1,",50)="DGWP"
. S DGWP(1,0)=DGWORD
. I $D(DGFDA) D UPD
Q
UPD ;call UPDATE^DIE
S DGIEN(1)=$P(DGX,U,3)
D UPDATE^DIE("E","DGFDA","DGIEN","DGERR")
I $D(DGERR) D BMES^XPDUTL(" >>> ERROR! "_$P($G(DGX),U)_" not added to file #38.6"),MES^XPDUTL(DGERR("DIERR",1)_": "_DGERR("DIERR",1,"TEXT",1)) Q
D BMES^XPDUTL(" "_$P($G(DGX),U)_" successfully added.")
Q
SET ;set the entry field values into variables
N DGA,DGB
S DGA="NO CV, CHECK "
S DGB="Imprecise or Missing"
S DGWORD="Combat Vet status cannot be determined if critical dates are missing or imprecise."
S DG67=DGA_"SERVICE SEP DATE^SERVICE SEPARATION DATE [LAST] "_DGB_"^"_67
S DG68=DGA_"COMBAT TO DATE^COMBAT TO DATE "_DGB_"^"_68
S DG69=DGA_"YUGOSLAV TO DATE^YUGOSLAVIA TO DATE "_DGB_"^"_69
S DG70=DGA_"SOMALIA TO DATE^SOMALIA TO DATE "_DGB_"^"_70
S DG71=DGA_"PERS GULF TO DATE^PERSIAN GULF TO DATE "_DGB_"^"_71
Q
;
POST ;post install routine for Combat Veteran - will loop through the
;Patient file and populate field .5295 (Combat Veteran End Date)
;for any veterans who are eligible (.5296 will be also stuffed with
;the current date in SERCV^DGCV and DELCV^DGCV)
N DFN,DG,DGDONE,ZTSAVE
D POST1 Q:DGDONE
D POSTQ
Q
POST1 ;check to see if process already finished, already started or currently
;running
N DGMSG,DGSTAT,DGTASK
S DGDONE=0
I '$D(^XTMP("DGCV")) Q
I $G(^XTMP("DGCV","DONE"))=1 D Q
. S DGMSG="COMBAT VET INITIAL SEEDING COMPLETED ON PREVIOUS INSTALL. EXITING"
. D BMES^XPDUTL(.DGMSG)
. S DGDONE=1
I $G(DGREQ)'=1 K ^XTMP("DGCV")
S DGTASK=$G(^XTMP("DGCV","TASK"))
I DGTASK'="" D
. S DGSTAT=$$ACTIVE(DGTASK)
. I DGSTAT>0 S DGMSG="Task: "_DGTASK_" is currently running, cannot start duplicate process." D
. . D BMES^XPDUTL(.DGMSG)
. . S DGDONE=1
Q
ACTIVE(DGTASK) ;check to see if task already running
; DGTASK - taskman task number
; output - (1,0) is the task running?
N DGSTAT,Y,ZTSK
S DGSTAT=0,ZTSK=DGTASK
D STAT^%ZTLOAD
S Y=ZTSK(1)
I Y=0 S DGSTAT=-1
I ",1,2,"[(","_Y_",") S DGSTAT=1
I ",3,5,"[(","_Y_",") S DGSTAT=0
Q DGSTAT
POSTQ ;queue the task
N DGTXT,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
S ZTRTN="LOOP^DG53528P",ZTIO="",ZTDTH=$$NOW^XLFDT()
S ZTDESC="COMBAT VET INITIAL DATA SEEDING"
S ZTSAVE("POS1")="",ZTSAVE("XPDQUES")=""
S ZTSAVE("*")=""
D NOW^%DTC
S ZTDTH=%
D ^%ZTLOAD
S ^XTMP("DGCV","TASK")=ZTSK
S DGTXT(1)="Task: "_ZTSK_" queued."
D BMES^XPDUTL(.DGTXT)
Q
LOOP ;
N DGC,DGT,X,X1,X2,ZTSTOP
S (DFN,DGC,DGT,ZTSTOP)=0
S DFN=+$G(^XTMP("DGCV","DFN"))
S X1=DT,X2=30 D C^%DTC
S ^XTMP("DGCV",0)=X_"^"_$$DT^XLFDT_"^Combat Veteran Initial Patient File Seeding - DG*5.3*528"
I '$D(^XTMP("DGCV","START")) S ^XTMP("DGCV","START")=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
I $G(XPDQUES("POS1","B"))]"" S IOP=$G(XPDQUES("POS1","B")) ;result of install question
I $G(IOP)]"" D
. S IOP=$O(^%ZIS(1,"B",IOP,""))
. S IOP="`"_IOP
I $G(IOP)]"" D
. S ^XTMP("DGCV","DEVICE")=IOP
. I '$D(^XTMP("DGCV",0)) D
. . N X,X1,X2
. . S X1=DT,X2=60 D C^%DTC
. . S ^XTMP("DGCV",0)=X_"^"_$$DT^XLFDT_"^Combat Veteran Initial Patient File Seeding - DG*5.3*528"
;
F S DFN=$O(^DPT(DFN)) Q:+DFN=0!(ZTSTOP) D
. S DG=0
. S DGT=DGT+1 ;count of records checked
. S ^XTMP("DGCV","DFN")=DFN ;current DFN
. I (DGT#1000=0),($$S^%ZTLOAD) S ZTSTOP=1 ;is there a stop request?
. S DG=$$CVELIG^DGCV(DFN)
. I +$G(DG)=1 D
. . S DGSRV=$$GET1^DIQ(2,DFN_",",.327,"I")
. . I $G(DGSRV)']"" Q
. . D SETCV^DGCV(DFN,DGSRV)
. . S DGC=DGC+1
. S ^XTMP("DGCV","COUNT")=DGT_"^"_DGC
. Q:$G(DGSRV)']""
. I $G(DG)=0!($G(DG)=1)!($G(DG)']"") Q
. D RPT^DGCV1(DG)
S $P(^XTMP("DGCV","START"),U,2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
I ZTSTOP D Q
. N DGMSG,XMDUZ,XMSUB,XMTEXT,XMY
. S XMSUB="COMBAT VET INITIAL DATA SEEDING"
. S DGMSG(1)="Patch DG*5.3*528"
. S DGMSG(2)="Combat Veteran Initial database seeding was interrupted by"
. S DGMSG(3)="user request. Please re-start by using the following command at the"
. S DGMSG(4)="programmer prompt."
. S DGMSG(5)="D REQUE^DG53528P"
. D BMES^XPDUTL(.DGMSG)
. D SENDMSG^XMXAPI(DUZ,XMSUB,"DGMSG",DUZ)
D REPORT^DGCV1
N DGMSG
S DGMSG(1)=""
S DGMSG(2)=" Patient file seeding completed...."
S XMSUB="COMBAT VET INITIAL DATA SEEDING - DG*5.3*528"
D SENDMSG^XMXAPI(DUZ,XMSUB,"DGMSG",DUZ)
D BMES^XPDUTL(.DGMSG)
S ^XTMP("DGCV","DONE")=1
K DG,DGCOM,DGCVDT,DGGULF,DGSOM,DGSRV,DGYUG
Q
REQUE ;requeue initial seeding if interrupted
N DGREQ
S DGREQ=1
D POST
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53528P 5541 printed Nov 22, 2024@17:47:44 Page 2
DG53528P ;ALB/ERC - COMBAT VET PRE & POSTINSTALLS ;7/22/03
+1 ;;5.3;Registration;**528**; Aug 13, 1993
+2 ;
PRE ;add 5 new entries to the INCONSISTENT DATA ELEMENTS file (#38.6)
+1 ;to alert users that critical dates for the determination of CV
+2 ;status are either imprecise or missing
+3 ;
+4 ;first check to see if patch already installed - if so do not
+5 ;add these new entries
+6 IF $$PATCH^XPDUTL("DG*5.3*528")
QUIT
+7 NEW DGK,DGWP
+8 KILL XPDABORT
+9 FOR DGK=67:1:71
IF $DATA(^DGIN(38.6,DGK))
if $GET(XPDABORT)=2
QUIT
Begin DoDot:1
+10 DO BMES^XPDUTL(" ** Internal Entry # "_DGK_" already exists in file #38.6, contact NVS **")
+11 SET XPDABORT=2
End DoDot:1
+12 IF $GET(XPDABORT)'=2
Begin DoDot:1
+13 DO BMES^XPDUTL(" >> Adding new entries into the INCONSISTENT DATA ELEMENTS file (#38.6).")
+14 DO ADD
End DoDot:1
+15 QUIT
ADD ;set up FDA arrays for the addition of new entries in 38.6
+1 NEW DG,DG67,DG68,DG69,DG70,DG71,DGERR,DGFDA,DGIEN,DGWORD,DGX
+2 DO SET
+3 FOR DGX=DG67,DG68,DG69,DG70,DG71
Begin DoDot:1
+4 KILL DGFDA
+5 SET DGFDA(38.6,"+1,",.01)=$PIECE(DGX,U)
+6 SET DGFDA(38.6,"+1,",2)=$PIECE(DGX,U,2)
+7 SET DGFDA(38.6,"+1,",50)="DGWP"
+8 SET DGWP(1,0)=DGWORD
+9 IF $DATA(DGFDA)
DO UPD
End DoDot:1
+10 QUIT
UPD ;call UPDATE^DIE
+1 SET DGIEN(1)=$PIECE(DGX,U,3)
+2 DO UPDATE^DIE("E","DGFDA","DGIEN","DGERR")
+3 IF $DATA(DGERR)
DO BMES^XPDUTL(" >>> ERROR! "_$PIECE($GET(DGX),U)_" not added to file #38.6")
DO MES^XPDUTL(DGERR("DIERR",1)_": "_DGERR("DIERR",1,"TEXT",1))
QUIT
+4 DO BMES^XPDUTL(" "_$PIECE($GET(DGX),U)_" successfully added.")
+5 QUIT
SET ;set the entry field values into variables
+1 NEW DGA,DGB
+2 SET DGA="NO CV, CHECK "
+3 SET DGB="Imprecise or Missing"
+4 SET DGWORD="Combat Vet status cannot be determined if critical dates are missing or imprecise."
+5 SET DG67=DGA_"SERVICE SEP DATE^SERVICE SEPARATION DATE [LAST] "_DGB_"^"_67
+6 SET DG68=DGA_"COMBAT TO DATE^COMBAT TO DATE "_DGB_"^"_68
+7 SET DG69=DGA_"YUGOSLAV TO DATE^YUGOSLAVIA TO DATE "_DGB_"^"_69
+8 SET DG70=DGA_"SOMALIA TO DATE^SOMALIA TO DATE "_DGB_"^"_70
+9 SET DG71=DGA_"PERS GULF TO DATE^PERSIAN GULF TO DATE "_DGB_"^"_71
+10 QUIT
+11 ;
POST ;post install routine for Combat Veteran - will loop through the
+1 ;Patient file and populate field .5295 (Combat Veteran End Date)
+2 ;for any veterans who are eligible (.5296 will be also stuffed with
+3 ;the current date in SERCV^DGCV and DELCV^DGCV)
+4 NEW DFN,DG,DGDONE,ZTSAVE
+5 DO POST1
if DGDONE
QUIT
+6 DO POSTQ
+7 QUIT
POST1 ;check to see if process already finished, already started or currently
+1 ;running
+2 NEW DGMSG,DGSTAT,DGTASK
+3 SET DGDONE=0
+4 IF '$DATA(^XTMP("DGCV"))
QUIT
+5 IF $GET(^XTMP("DGCV","DONE"))=1
Begin DoDot:1
+6 SET DGMSG="COMBAT VET INITIAL SEEDING COMPLETED ON PREVIOUS INSTALL. EXITING"
+7 DO BMES^XPDUTL(.DGMSG)
+8 SET DGDONE=1
End DoDot:1
QUIT
+9 IF $GET(DGREQ)'=1
KILL ^XTMP("DGCV")
+10 SET DGTASK=$GET(^XTMP("DGCV","TASK"))
+11 IF DGTASK'=""
Begin DoDot:1
+12 SET DGSTAT=$$ACTIVE(DGTASK)
+13 IF DGSTAT>0
SET DGMSG="Task: "_DGTASK_" is currently running, cannot start duplicate process."
Begin DoDot:2
+14 DO BMES^XPDUTL(.DGMSG)
+15 SET DGDONE=1
End DoDot:2
End DoDot:1
+16 QUIT
ACTIVE(DGTASK) ;check to see if task already running
+1 ; DGTASK - taskman task number
+2 ; output - (1,0) is the task running?
+3 NEW DGSTAT,Y,ZTSK
+4 SET DGSTAT=0
SET ZTSK=DGTASK
+5 DO STAT^%ZTLOAD
+6 SET Y=ZTSK(1)
+7 IF Y=0
SET DGSTAT=-1
+8 IF ",1,2,"[(","_Y_",")
SET DGSTAT=1
+9 IF ",3,5,"[(","_Y_",")
SET DGSTAT=0
+10 QUIT DGSTAT
POSTQ ;queue the task
+1 NEW DGTXT,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
+2 SET ZTRTN="LOOP^DG53528P"
SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT()
+3 SET ZTDESC="COMBAT VET INITIAL DATA SEEDING"
+4 SET ZTSAVE("POS1")=""
SET ZTSAVE("XPDQUES")=""
+5 SET ZTSAVE("*")=""
+6 DO NOW^%DTC
+7 SET ZTDTH=%
+8 DO ^%ZTLOAD
+9 SET ^XTMP("DGCV","TASK")=ZTSK
+10 SET DGTXT(1)="Task: "_ZTSK_" queued."
+11 DO BMES^XPDUTL(.DGTXT)
+12 QUIT
LOOP ;
+1 NEW DGC,DGT,X,X1,X2,ZTSTOP
+2 SET (DFN,DGC,DGT,ZTSTOP)=0
+3 SET DFN=+$GET(^XTMP("DGCV","DFN"))
+4 SET X1=DT
SET X2=30
DO C^%DTC
+5 SET ^XTMP("DGCV",0)=X_"^"_$$DT^XLFDT_"^Combat Veteran Initial Patient File Seeding - DG*5.3*528"
+6 IF '$DATA(^XTMP("DGCV","START"))
SET ^XTMP("DGCV","START")=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
+7 ;result of install question
IF $GET(XPDQUES("POS1","B"))]""
SET IOP=$GET(XPDQUES("POS1","B"))
+8 IF $GET(IOP)]""
Begin DoDot:1
+9 SET IOP=$ORDER(^%ZIS(1,"B",IOP,""))
+10 SET IOP="`"_IOP
End DoDot:1
+11 IF $GET(IOP)]""
Begin DoDot:1
+12 SET ^XTMP("DGCV","DEVICE")=IOP
+13 IF '$DATA(^XTMP("DGCV",0))
Begin DoDot:2
+14 NEW X,X1,X2
+15 SET X1=DT
SET X2=60
DO C^%DTC
+16 SET ^XTMP("DGCV",0)=X_"^"_$$DT^XLFDT_"^Combat Veteran Initial Patient File Seeding - DG*5.3*528"
End DoDot:2
End DoDot:1
+17 ;
+18 FOR
SET DFN=$ORDER(^DPT(DFN))
if +DFN=0!(ZTSTOP)
QUIT
Begin DoDot:1
+19 SET DG=0
+20 ;count of records checked
SET DGT=DGT+1
+21 ;current DFN
SET ^XTMP("DGCV","DFN")=DFN
+22 ;is there a stop request?
IF (DGT#1000=0)
IF ($$S^%ZTLOAD)
SET ZTSTOP=1
+23 SET DG=$$CVELIG^DGCV(DFN)
+24 IF +$GET(DG)=1
Begin DoDot:2
+25 SET DGSRV=$$GET1^DIQ(2,DFN_",",.327,"I")
+26 IF $GET(DGSRV)']""
QUIT
+27 DO SETCV^DGCV(DFN,DGSRV)
+28 SET DGC=DGC+1
End DoDot:2
+29 SET ^XTMP("DGCV","COUNT")=DGT_"^"_DGC
+30 if $GET(DGSRV)']""
QUIT
+31 IF $GET(DG)=0!($GET(DG)=1)!($GET(DG)']"")
QUIT
+32 DO RPT^DGCV1(DG)
End DoDot:1
+33 SET $PIECE(^XTMP("DGCV","START"),U,2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
+34 IF ZTSTOP
Begin DoDot:1
+35 NEW DGMSG,XMDUZ,XMSUB,XMTEXT,XMY
+36 SET XMSUB="COMBAT VET INITIAL DATA SEEDING"
+37 SET DGMSG(1)="Patch DG*5.3*528"
+38 SET DGMSG(2)="Combat Veteran Initial database seeding was interrupted by"
+39 SET DGMSG(3)="user request. Please re-start by using the following command at the"
+40 SET DGMSG(4)="programmer prompt."
+41 SET DGMSG(5)="D REQUE^DG53528P"
+42 DO BMES^XPDUTL(.DGMSG)
+43 DO SENDMSG^XMXAPI(DUZ,XMSUB,"DGMSG",DUZ)
End DoDot:1
QUIT
+44 DO REPORT^DGCV1
+45 NEW DGMSG
+46 SET DGMSG(1)=""
+47 SET DGMSG(2)=" Patient file seeding completed...."
+48 SET XMSUB="COMBAT VET INITIAL DATA SEEDING - DG*5.3*528"
+49 DO SENDMSG^XMXAPI(DUZ,XMSUB,"DGMSG",DUZ)
+50 DO BMES^XPDUTL(.DGMSG)
+51 SET ^XTMP("DGCV","DONE")=1
+52 KILL DG,DGCOM,DGCVDT,DGGULF,DGSOM,DGSRV,DGYUG
+53 QUIT
REQUE ;requeue initial seeding if interrupted
+1 NEW DGREQ
+2 SET DGREQ=1
+3 DO POST
+4 QUIT
