source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53528P.m@ 1801

Last change on this file since 1801 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.3 KB
RevLine 
[613]1DG53528P ;ALB/ERC - COMBAT VET PRE & POSTINSTALLS ;7/22/03
2 ;;5.3;Registration;**528**; Aug 13, 1993
3 ;
4PRE ;add 5 new entries to the INCONSISTENT DATA ELEMENTS file (#38.6)
5 ;to alert users that critical dates for the determination of CV
6 ;status are either imprecise or missing
7 ;
8 ;first check to see if patch already installed - if so do not
9 ;add these new entries
10 I $$PATCH^XPDUTL("DG*5.3*528") Q
11 N DGK,DGWP
12 K XPDABORT
13 F DGK=67:1:71 I $D(^DGIN(38.6,DGK)) Q:$G(XPDABORT)=2 D
14 . D BMES^XPDUTL(" ** Internal Entry # "_DGK_" already exists in file #38.6, contact NVS **")
15 . S XPDABORT=2
16 I $G(XPDABORT)'=2 D
17 . D BMES^XPDUTL(" >> Adding new entries into the INCONSISTENT DATA ELEMENTS file (#38.6).")
18 . D ADD
19 Q
20ADD ;set up FDA arrays for the addition of new entries in 38.6
21 N DG,DG67,DG68,DG69,DG70,DG71,DGERR,DGFDA,DGIEN,DGWORD,DGX
22 D SET
23 F DGX=DG67,DG68,DG69,DG70,DG71 D
24 . K DGFDA
25 . S DGFDA(38.6,"+1,",.01)=$P(DGX,U)
26 . S DGFDA(38.6,"+1,",2)=$P(DGX,U,2)
27 . S DGFDA(38.6,"+1,",50)="DGWP"
28 . S DGWP(1,0)=DGWORD
29 . I $D(DGFDA) D UPD
30 Q
31UPD ;call UPDATE^DIE
32 S DGIEN(1)=$P(DGX,U,3)
33 D UPDATE^DIE("E","DGFDA","DGIEN","DGERR")
34 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
35 D BMES^XPDUTL(" "_$P($G(DGX),U)_" successfully added.")
36 Q
37SET ;set the entry field values into variables
38 N DGA,DGB
39 S DGA="NO CV, CHECK "
40 S DGB="Imprecise or Missing"
41 S DGWORD="Combat Vet status cannot be determined if critical dates are missing or imprecise."
42 S DG67=DGA_"SERVICE SEP DATE^SERVICE SEPARATION DATE [LAST] "_DGB_"^"_67
43 S DG68=DGA_"COMBAT TO DATE^COMBAT TO DATE "_DGB_"^"_68
44 S DG69=DGA_"YUGOSLAV TO DATE^YUGOSLAVIA TO DATE "_DGB_"^"_69
45 S DG70=DGA_"SOMALIA TO DATE^SOMALIA TO DATE "_DGB_"^"_70
46 S DG71=DGA_"PERS GULF TO DATE^PERSIAN GULF TO DATE "_DGB_"^"_71
47 Q
48 ;
49POST ;post install routine for Combat Veteran - will loop through the
50 ;Patient file and populate field .5295 (Combat Veteran End Date)
51 ;for any veterans who are eligible (.5296 will be also stuffed with
52 ;the current date in SERCV^DGCV and DELCV^DGCV)
53 N DFN,DG,DGDONE,ZTSAVE
54 D POST1 Q:DGDONE
55 D POSTQ
56 Q
57POST1 ;check to see if process already finished, already started or currently
58 ;running
59 N DGMSG,DGSTAT,DGTASK
60 S DGDONE=0
61 I '$D(^XTMP("DGCV")) Q
62 I $G(^XTMP("DGCV","DONE"))=1 D Q
63 . S DGMSG="COMBAT VET INITIAL SEEDING COMPLETED ON PREVIOUS INSTALL. EXITING"
64 . D BMES^XPDUTL(.DGMSG)
65 . S DGDONE=1
66 I $G(DGREQ)'=1 K ^XTMP("DGCV")
67 S DGTASK=$G(^XTMP("DGCV","TASK"))
68 I DGTASK'="" D
69 . S DGSTAT=$$ACTIVE(DGTASK)
70 . I DGSTAT>0 S DGMSG="Task: "_DGTASK_" is currently running, cannot start duplicate process." D
71 . . D BMES^XPDUTL(.DGMSG)
72 . . S DGDONE=1
73 Q
74ACTIVE(DGTASK) ;check to see if task already running
75 ; DGTASK - taskman task number
76 ; output - (1,0) is the task running?
77 N DGSTAT,Y,ZTSK
78 S DGSTAT=0,ZTSK=DGTASK
79 D STAT^%ZTLOAD
80 S Y=ZTSK(1)
81 I Y=0 S DGSTAT=-1
82 I ",1,2,"[(","_Y_",") S DGSTAT=1
83 I ",3,5,"[(","_Y_",") S DGSTAT=0
84 Q DGSTAT
85POSTQ ;queue the task
86 N DGTXT,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSK
87 S ZTRTN="LOOP^DG53528P",ZTIO="",ZTDTH=$$NOW^XLFDT()
88 S ZTDESC="COMBAT VET INITIAL DATA SEEDING"
89 S ZTSAVE("POS1")="",ZTSAVE("XPDQUES")=""
90 S ZTSAVE("*")=""
91 D NOW^%DTC
92 S ZTDTH=%
93 D ^%ZTLOAD
94 S ^XTMP("DGCV","TASK")=ZTSK
95 S DGTXT(1)="Task: "_ZTSK_" queued."
96 D BMES^XPDUTL(.DGTXT)
97 Q
98LOOP ;
99 N DGC,DGT,X,X1,X2,ZTSTOP
100 S (DFN,DGC,DGT,ZTSTOP)=0
101 S DFN=+$G(^XTMP("DGCV","DFN"))
102 S X1=DT,X2=30 D C^%DTC
103 S ^XTMP("DGCV",0)=X_"^"_$$DT^XLFDT_"^Combat Veteran Initial Patient File Seeding - DG*5.3*528"
104 I '$D(^XTMP("DGCV","START")) S ^XTMP("DGCV","START")=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
105 I $G(XPDQUES("POS1","B"))]"" S IOP=$G(XPDQUES("POS1","B")) ;result of install question
106 I $G(IOP)]"" D
107 . S IOP=$O(^%ZIS(1,"B",IOP,""))
108 . S IOP="`"_IOP
109 I $G(IOP)]"" D
110 . S ^XTMP("DGCV","DEVICE")=IOP
111 . I '$D(^XTMP("DGCV",0)) D
112 . . N X,X1,X2
113 . . S X1=DT,X2=60 D C^%DTC
114 . . S ^XTMP("DGCV",0)=X_"^"_$$DT^XLFDT_"^Combat Veteran Initial Patient File Seeding - DG*5.3*528"
115 ;
116 F S DFN=$O(^DPT(DFN)) Q:+DFN=0!(ZTSTOP) D
117 . S DG=0
118 . S DGT=DGT+1 ;count of records checked
119 . S ^XTMP("DGCV","DFN")=DFN ;current DFN
120 . I (DGT#1000=0),($$S^%ZTLOAD) S ZTSTOP=1 ;is there a stop request?
121 . S DG=$$CVELIG^DGCV(DFN)
122 . I +$G(DG)=1 D
123 . . S DGSRV=$$GET1^DIQ(2,DFN_",",.327,"I")
124 . . I $G(DGSRV)']"" Q
125 . . D SETCV^DGCV(DFN,DGSRV)
126 . . S DGC=DGC+1
127 . S ^XTMP("DGCV","COUNT")=DGT_"^"_DGC
128 . Q:$G(DGSRV)']""
129 . I $G(DG)=0!($G(DG)=1)!($G(DG)']"") Q
130 . D RPT^DGCV1(DG)
131 S $P(^XTMP("DGCV","START"),U,2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
132 I ZTSTOP D Q
133 . N DGMSG,XMDUZ,XMSUB,XMTEXT,XMY
134 . S XMSUB="COMBAT VET INITIAL DATA SEEDING"
135 . S DGMSG(1)="Patch DG*5.3*528"
136 . S DGMSG(2)="Combat Veteran Initial database seeding was interrupted by"
137 . S DGMSG(3)="user request. Please re-start by using the following command at the"
138 . S DGMSG(4)="programmer prompt."
139 . S DGMSG(5)="D REQUE^DG53528P"
140 . D BMES^XPDUTL(.DGMSG)
141 . D SENDMSG^XMXAPI(DUZ,XMSUB,"DGMSG",DUZ)
142 D REPORT^DGCV1
143 N DGMSG
144 S DGMSG(1)=""
145 S DGMSG(2)=" Patient file seeding completed...."
146 S XMSUB="COMBAT VET INITIAL DATA SEEDING - DG*5.3*528"
147 D SENDMSG^XMXAPI(DUZ,XMSUB,"DGMSG",DUZ)
148 D BMES^XPDUTL(.DGMSG)
149 S ^XTMP("DGCV","DONE")=1
150 K DG,DGCOM,DGCVDT,DGGULF,DGSOM,DGSRV,DGYUG
151 Q
152REQUE ;requeue initial seeding if interrupted
153 N DGREQ
154 S DGREQ=1
155 D POST
156 Q
Note: See TracBrowser for help on using the repository browser.