DG53528P.m

DG53528P ;ALB/ERC - COMBAT VET PRE & POSTINSTALLS ;7/22/03

 ;;5.3;Registration;**528,1015**; Aug 13, 1993;Build 21

 ;

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

DG53528P  ;ALB/ERC - COMBAT VET PRE & POSTINSTALLS ;7/22/03

 +1       ;;5.3;Registration;**528,1015**; Aug 13, 1993;Build 21

 +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