| 1 | SD53P495 ;ALB/RBS - ENV/POST-INSTALL FOR PATCH SD*5.3*495 ; 5/2/07 12:24pm
|
---|
| 2 | ;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
|
---|
| 3 | Q
|
---|
| 4 | ENV ;Environment check
|
---|
| 5 | S XPDABORT=""
|
---|
| 6 | ;checks programmer variables
|
---|
| 7 | D PROGCHK(.XPDABORT)
|
---|
| 8 | ;check if install is running
|
---|
| 9 | D ISRUNING(.XPDABORT)
|
---|
| 10 | I XPDABORT="" K XPDABORT
|
---|
| 11 | Q
|
---|
| 12 | POST ;Post-Install
|
---|
| 13 | D POST1
|
---|
| 14 | ;Check for SCOUT file
|
---|
| 15 | I '$D(^ANUSB(626140)) D Q
|
---|
| 16 | . D NOFILE
|
---|
| 17 | D TASK
|
---|
| 18 | Q
|
---|
| 19 | POST1 ;Set parameter value
|
---|
| 20 | N SDDAYS,SDERR,SDPARM
|
---|
| 21 | S SDPARM="SDSC SITE PARAMETER",SDDAYS=30
|
---|
| 22 | D EN^XPAR("DIV",SDPARM,1,SDDAYS,.SDERR)
|
---|
| 23 | D BMES^XPDUTL("******")
|
---|
| 24 | I '$G(SDERR) D
|
---|
| 25 | . D MES^XPDUTL(SDPARM_" parameter set to "_SDDAYS_" days SUCCESSFULLY.")
|
---|
| 26 | E D
|
---|
| 27 | . D MES^XPDUTL(SDPARM_" parameter set FAILED.")
|
---|
| 28 | D MES^XPDUTL("******")
|
---|
| 29 | Q
|
---|
| 30 | START ;Background job entry point
|
---|
| 31 | N SDAIEN,SDANUSB,SDX,SDFDAIEN,SDARAY,SDERAY,SDSAVE
|
---|
| 32 | N SDTOT,SDTOT1,SDTOT2,SDTOT3,SDENCPTR,SDCKCNT,SDSTOP,SDENT,SDFIL,DFN
|
---|
| 33 | D XTMP
|
---|
| 34 | ;seed var's if Re-Run
|
---|
| 35 | I $D(^XTMP("SD53P495","TOT")) D
|
---|
| 36 | . S SDTOT=+$G(^XTMP("SD53P495","TOT"))
|
---|
| 37 | . S SDTOT1=+$G(^XTMP("SD53P495","TOT1"))
|
---|
| 38 | . S SDTOT2=+$G(^XTMP("SD53P495","TOT2"))
|
---|
| 39 | . S SDTOT3=+$G(^XTMP("SD53P495","TOT3"))
|
---|
| 40 | . S (SDSAVE,SDENCPTR)=+$G(^XTMP("SD53P495","ENCOUNTER"))
|
---|
| 41 | E D
|
---|
| 42 | . S (SDAIEN,SDENCPTR,SDSAVE,SDTOT,SDTOT1,SDTOT2,SDTOT3)=0
|
---|
| 43 | S SDCKCNT=100,SDSTOP=0
|
---|
| 44 | F S SDENCPTR=$O(^ANUSB(626140,"B",SDENCPTR)) Q:'SDENCPTR D Q:SDSTOP
|
---|
| 45 | . S SDSAVE=SDENCPTR
|
---|
| 46 | . K SDANUSB,SDARAY,SDERAY,SDENT
|
---|
| 47 | . I +SDTOT#SDCKCNT=0,$$S^%ZTLOAD() S SDSTOP=1 Q
|
---|
| 48 | . S SDAIEN=$O(^ANUSB(626140,"B",SDENCPTR,""),-1)
|
---|
| 49 | . Q:'$G(SDAIEN)
|
---|
| 50 | . S SDANUSB=$G(^ANUSB(626140,SDAIEN,0))
|
---|
| 51 | . Q:'SDANUSB
|
---|
| 52 | . S SDTOT=SDTOT+1
|
---|
| 53 | . I $D(^SDSC(409.48,SDENCPTR,0)) S SDTOT3=SDTOT3+1 Q
|
---|
| 54 | . I '$$GETOE^SDOE(SDENCPTR) D Q
|
---|
| 55 | . . S DFN=$P(SDANUSB,U,11) D DEM^VADPT S DFN=$E(VADM(1),1,15)
|
---|
| 56 | . . S SDENT=DFN_" "_$$FMTE^XLFDT($P(SDANUSB,U,7),2)
|
---|
| 57 | . . D UPXTMP(SDENCPTR,"NO (O/P) ENCOUNTER RECORD (#409.68)",SDENT) S SDTOT2=SDTOT2+1
|
---|
| 58 | . D GETS^DIQ(626140,SDAIEN_",","**","I","SDARAY","SDERAY")
|
---|
| 59 | . I $D(SDERAY) D Q
|
---|
| 60 | . . S SDENT=$G(SDERAY("DIERR",1,"TEXT",1))
|
---|
| 61 | . . D UPXTMP(SDENCPTR,"NO (SCOUT) FILE DATA (#626140)",SDENT) S SDTOT2=SDTOT2+1
|
---|
| 62 | . S SDFIL=$$FILE(SDENCPTR,SDAIEN,.SDARAY)
|
---|
| 63 | . I '+SDFIL D Q
|
---|
| 64 | . . D UPXTMP(SDENCPTR,"FILING ERROR TO (#409.48)",$P(SDFIL,"^",2)) S SDTOT2=SDTOT2+1
|
---|
| 65 | . E D
|
---|
| 66 | . . S SDTOT1=SDTOT1+1
|
---|
| 67 | I SDSTOP D
|
---|
| 68 | . S ^XTMP("SD53P495","STOPPED")=$$NOW^XLFDT()
|
---|
| 69 | . S ZTSTOP=1
|
---|
| 70 | E D
|
---|
| 71 | . S ^XTMP("SD53P495","COMPLETED")=$$NOW^XLFDT()
|
---|
| 72 | S ^XTMP("SD53P495","ENCOUNTER")=SDSAVE
|
---|
| 73 | S ^XTMP("SD53P495","TOT")=SDTOT,^XTMP("SD53P495","TOT1")=SDTOT1
|
---|
| 74 | S ^XTMP("SD53P495","TOT2")=SDTOT2,^XTMP("SD53P495","TOT3")=SDTOT3
|
---|
| 75 | K ^XTMP("SD53P495","RUNNING") D KVA^VADPT
|
---|
| 76 | D SENDMSG(SDSTOP)
|
---|
| 77 | Q
|
---|
| 78 | FILE(SDENCPTR,SDAIEN,SDARAY) ;file new entry
|
---|
| 79 | ; create #409.48 file
|
---|
| 80 | ; Input:
|
---|
| 81 | ; SDENCPTR - [required] O/P Encounter file pointer (#409.68)
|
---|
| 82 | ; SDAIEN - [required] IEN of (#626140) record to convert
|
---|
| 83 | ; SDARAY - [required] Array of Internal values of all fields
|
---|
| 84 | ; Output:
|
---|
| 85 | ; Function Value - returns 1 on success, 0 on failure and error msg
|
---|
| 86 | I '+$G(SDENCPTR)!'+$G(SDAIEN)!('$D(SDARAY)) Q 0
|
---|
| 87 | N SDERR,SDFDA,SDFLD,SDFDAIEN,SDI,SDIENS,SDNUM,SDSTR,SDSTR1,SDSUB
|
---|
| 88 | N DIC,DICR,DIE,DIERR,DD,DG,DO,DR,DA
|
---|
| 89 | ; DINUM=X setup so new file IEN = O/P Encounter IEN
|
---|
| 90 | S SDFDAIEN(1)=SDENCPTR
|
---|
| 91 | ; setup main fields
|
---|
| 92 | S SDIENS="+1,",SDAIEN=SDAIEN_","
|
---|
| 93 | S SDSTR=".01^.02^.03^.04^.05^.06^.07^.08^.09^.1^.11^.12"
|
---|
| 94 | F SDI=1:1:12 D
|
---|
| 95 | . S SDFLD=$P(SDSTR,U,SDI)
|
---|
| 96 | . S SDFDA(409.48,SDIENS,SDFLD)=$G(SDARAY(626140,SDAIEN,SDFLD,"I"))
|
---|
| 97 | S SDFDA(409.48,SDIENS,.13)=1 ;SCOUT was always a 1 (SC)
|
---|
| 98 | ; setup fields of (#409.481) multiple
|
---|
| 99 | I $D(SDARAY(626140.01)) D
|
---|
| 100 | . S SDSTR1=".01^.02^.03^.04^.05^.06",SDNUM=1,(SDSUB,SDIENS)=""
|
---|
| 101 | . F S SDSUB=$O(SDARAY(626140.01,SDSUB)) Q:SDSUB="" D
|
---|
| 102 | . . S SDNUM=SDNUM+1
|
---|
| 103 | . . F SDI=1:1:6 S SDFLD=$P(SDSTR1,U,SDI) D
|
---|
| 104 | . . . S SDIENS="+"_SDNUM_",+1,"
|
---|
| 105 | . . . S SDFDA(409.481,SDIENS,SDFLD)=$G(SDARAY(626140.01,SDSUB,SDFLD,"I"))
|
---|
| 106 | D UPDATE^DIE("","SDFDA","SDFDAIEN","SDERR")
|
---|
| 107 | Q $S($D(SDERR):0,1:1)_"^"_$S($D(SDERR):$G(SDERR("DIERR",1,"TEXT",1)),1:"")
|
---|
| 108 | SENDMSG(SDSTOP) ;send MailMan msg to patch installer
|
---|
| 109 | N DIFROM,SDMSG,SDTXT,SDLN,XMY,XMDUZ,XMSUB,XMTEXT,XMDUN,XMZ
|
---|
| 110 | K ^TMP("SD53P495",$J)
|
---|
| 111 | S XMSUB="SD*5.3*495 (SCOUT) FILE CONVERSION REPORT"
|
---|
| 112 | S XMTEXT="^TMP(""SD53P495"",$J,",XMDUZ=.5,(XMY(DUZ),XMY(XMDUZ))=""
|
---|
| 113 | S SDLN=0
|
---|
| 114 | D ADD(.SDLN,"Patch: SD*5.3*495 Automated Service Connected Designation")
|
---|
| 115 | D ADD(.SDLN," "),ADD(.SDLN,"************")
|
---|
| 116 | D ADD(.SDLN,"The existing Class III (SCOUT) file, ANU SERVICE CONNECTED CHANGES (#626140),")
|
---|
| 117 | D ADD(.SDLN,"which contains O/P Encounter records that have been compiled for additional")
|
---|
| 118 | D ADD(.SDLN,"Service Connected (SC) review, has been used to create a new Class I file")
|
---|
| 119 | D ADD(.SDLN,"which will provide the same functionality.")
|
---|
| 120 | D ADD(.SDLN," ")
|
---|
| 121 | D ADD(.SDLN,"Only valid O/P Encounter records from the Class III (SCOUT) file,")
|
---|
| 122 | D ADD(.SDLN,"ANU SERVICE CONNECTED CHANGES (#626140), have been filed into")
|
---|
| 123 | D ADD(.SDLN,"the new SDSC SERVICE CONNECTED CHANGES (#409.48) file.")
|
---|
| 124 | D ADD(.SDLN," ")
|
---|
| 125 | D ADD(.SDLN,"The new Automated Service Connected Designation (ASCD) Menu Options")
|
---|
| 126 | D ADD(.SDLN,"enable user access to the O/P Encounter records in the (#409.48) file.")
|
---|
| 127 | D ADD(.SDLN,"************"),ADD(.SDLN," "),ADD(.SDLN," ")
|
---|
| 128 | D ADD(.SDLN,"SUMMARY OF PROCESSING RESULTS:")
|
---|
| 129 | D ADD(.SDLN,"==============================")
|
---|
| 130 | D ADD(.SDLN," ")
|
---|
| 131 | D ADD(.SDLN,"<<< The Class III (SCOUT) File Conversion has "_$S(+$G(SDSTOP):"NOT ",1:"")_"Completed. >>>")
|
---|
| 132 | I +$G(SDSTOP) D
|
---|
| 133 | . D ADD(.SDLN," Please restart the post-install process from the following")
|
---|
| 134 | . D ADD(.SDLN," programmer's prompt:")
|
---|
| 135 | . D ADD(.SDLN," D POST^SD53P495")
|
---|
| 136 | D ADD(.SDLN," "),ADD(.SDLN," ")
|
---|
| 137 | D ADD(.SDLN," DATE/TIME TASK STARTED: "_$$FMTE^XLFDT(+$G(^XTMP("SD53P495","START")),"P"))
|
---|
| 138 | I $G(SDSTOP) D
|
---|
| 139 | . D ADD(.SDLN," DATE/TIME TASK STOPPED: "_$$FMTE^XLFDT(+$G(^XTMP("SD53P495","STOPPED")),"P"))
|
---|
| 140 | E D
|
---|
| 141 | . D ADD(.SDLN,"DATE/TIME TASK COMPLETED: "_$$FMTE^XLFDT(+$G(^XTMP("SD53P495","COMPLETED")),"P"))
|
---|
| 142 | I $D(^XTMP("SD53P495","LAST RUN")) D
|
---|
| 143 | . D ADD(.SDLN," DATE/TIME LAST RUN: "_$$FMTE^XLFDT(+$G(^XTMP("SD53P495","LAST RUN")),"P"))
|
---|
| 144 | D ADD(.SDLN," "),ADD(.SDLN," ")
|
---|
| 145 | D ADD(.SDLN," TOTAL O/P ENCOUNTER RECORDS FOUND: "_+$G(^XTMP("SD53P495","TOT")))
|
---|
| 146 | I +$G(^XTMP("SD53P495","TOT3")) D
|
---|
| 147 | . D ADD(.SDLN," TOTAL RECORDS PREVIOUSLY CONVERTED: "_+$G(^XTMP("SD53P495","TOT3")))
|
---|
| 148 | D ADD(.SDLN," TOTAL O/P ENCOUNTER RECORDS CONVERTED: "_+$G(^XTMP("SD53P495","TOT1")))
|
---|
| 149 | D ADD(.SDLN,"TOTAL O/P ENCOUNTER RECORDS NOT CONVERTED: "_+$G(^XTMP("SD53P495","TOT2")))
|
---|
| 150 | I +$G(^XTMP("SD53P495","TOT2")) D
|
---|
| 151 | . D ADD(.SDLN," :")
|
---|
| 152 | . N SDSUB,SDIEN,SDENT
|
---|
| 153 | . S (SDSUB,SDIEN)=""
|
---|
| 154 | . F S SDSUB=$O(^XTMP("SD53P495","TOT2",SDSUB)) Q:SDSUB="" D
|
---|
| 155 | . . D ADD(.SDLN," REASON NOT CONVERTED: "_SDSUB)
|
---|
| 156 | . . D ADD(.SDLN," O/P ENCOUNTER IEN:")
|
---|
| 157 | . . F S SDIEN=$O(^XTMP("SD53P495","TOT2",SDSUB,SDIEN)) Q:'SDIEN D
|
---|
| 158 | . . . S SDENT=$E(^XTMP("SD53P495","TOT2",SDSUB,SDIEN),1,30)
|
---|
| 159 | . . . D ADD(.SDLN," : "_SDIEN_"-"_SDENT)
|
---|
| 160 | . . D ADD(.SDLN," :")
|
---|
| 161 | D ADD(.SDLN," <END OF REPORT> :")
|
---|
| 162 | D ^XMD
|
---|
| 163 | K ^TMP("SD53P495",$J)
|
---|
| 164 | Q
|
---|
| 165 | ADD(SDLN,SDTXT) ;add line
|
---|
| 166 | Q:$L(SDTXT)'>0
|
---|
| 167 | S SDLN=$G(SDLN)+1
|
---|
| 168 | S ^TMP("SD53P495",$J,SDLN)=SDTXT
|
---|
| 169 | Q
|
---|
| 170 | PROGCHK(XPDABORT) ;checks programmer variables
|
---|
| 171 | I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D
|
---|
| 172 | . D BMES^XPDUTL("******")
|
---|
| 173 | . D MES^XPDUTL("Your programming variables are not set up properly.")
|
---|
| 174 | . D MES^XPDUTL("Installation aborted.")
|
---|
| 175 | . D MES^XPDUTL("******")
|
---|
| 176 | . S XPDABORT=2
|
---|
| 177 | Q
|
---|
| 178 | ISRUNING(XPDABORT) ;check if running
|
---|
| 179 | I +$G(^XTMP("SD53P495","RUNNING")) D
|
---|
| 180 | . D BMES^XPDUTL("******")
|
---|
| 181 | . D MES^XPDUTL("This patch is currently being Installed. Try later.")
|
---|
| 182 | . D MES^XPDUTL("Installation aborted...")
|
---|
| 183 | . D MES^XPDUTL("******")
|
---|
| 184 | . S XPDABORT=2
|
---|
| 185 | Q
|
---|
| 186 | NOFILE ;no File
|
---|
| 187 | D BMES^XPDUTL("******")
|
---|
| 188 | D MES^XPDUTL("The Class III (SCOUT) File Conversion is NOT necessary because")
|
---|
| 189 | D MES^XPDUTL("the ANU SERVICE CONNECTED CHANGES (#626140) file does not exist")
|
---|
| 190 | D MES^XPDUTL("on this system.")
|
---|
| 191 | D MES^XPDUTL("Post-Install process terminated...")
|
---|
| 192 | D MES^XPDUTL("******")
|
---|
| 193 | Q
|
---|
| 194 | TASK ;run TaskMan
|
---|
| 195 | N ZTSK,ZTDTH,ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTREQ,ZTSTOP,SDSTOP
|
---|
| 196 | S SDSTOP=+$G(^XTMP("SD53P495","STOPPED"))
|
---|
| 197 | S ZTRTN="START^SD53P495"
|
---|
| 198 | S ZTDESC="SD*5.3*495 (SCOUT) FILE CONVERSION PROCESSING"
|
---|
| 199 | S ZTIO="",ZTDTH=$H,ZTREQ="@",ZTSAVE("ZTREQ")=""
|
---|
| 200 | D ^%ZTLOAD
|
---|
| 201 | D BMES^XPDUTL("******")
|
---|
| 202 | I '$D(ZTSK) D
|
---|
| 203 | . D MES^XPDUTL("Unable to schedule TaskMan task to run the Class III (SCOUT) File")
|
---|
| 204 | . D MES^XPDUTL("Conversion.")
|
---|
| 205 | . D BMES^XPDUTL("Please re-run Post-Install routine POST^SD53P495 from")
|
---|
| 206 | . D MES^XPDUTL("the programmer prompt.")
|
---|
| 207 | . ;
|
---|
| 208 | E D
|
---|
| 209 | . D MES^XPDUTL("Task "_ZTSK_" has been "_$S(+SDSTOP:"Re-",1:"")_"started to run the Class III (SCOUT) File")
|
---|
| 210 | . D MES^XPDUTL("Conversion.")
|
---|
| 211 | . I SDSTOP D
|
---|
| 212 | . . D MES^XPDUTL(" <<< The last task run was STOPPED on "_$$FMTE^XLFDT(SDSTOP,"P")_". >>>")
|
---|
| 213 | . D BMES^XPDUTL("You will receive a MailMan message when this task is completed")
|
---|
| 214 | . D MES^XPDUTL("or if it has been manually stopped.")
|
---|
| 215 | D MES^XPDUTL("******")
|
---|
| 216 | Q
|
---|
| 217 | XTMP ;setup ^XTMP to control output for 90 days
|
---|
| 218 | I $D(^XTMP("SD53P495",0)) D
|
---|
| 219 | . S ^XTMP("SD53P495","LAST RUN")=$G(^XTMP("SD53P495","START"))
|
---|
| 220 | E D
|
---|
| 221 | . N SDX
|
---|
| 222 | . S SDX=$$FMADD^XLFDT($$NOW^XLFDT(),90)_U_$$NOW^XLFDT()
|
---|
| 223 | . S SDX=SDX_"^SD*5.3*495 (SCOUT) FILE CONVERSION PROCESSING"
|
---|
| 224 | . S ^XTMP("SD53P495",0)=SDX
|
---|
| 225 | S ^XTMP("SD53P495","START")=$$NOW^XLFDT()
|
---|
| 226 | S ^XTMP("SD53P495","RUNNING")="1"
|
---|
| 227 | Q
|
---|
| 228 | UPXTMP(SDENCPTR,NODE,SDENT) ;add to ^XTMP
|
---|
| 229 | ; Input:
|
---|
| 230 | ; SDENCPTR - Encounter IEN
|
---|
| 231 | ; NODE - Unique subscript
|
---|
| 232 | ; Output: none
|
---|
| 233 | Q:'$G(SDENCPTR)
|
---|
| 234 | I $G(NODE)="" S NODE="UNKNOWN"
|
---|
| 235 | S ^XTMP("SD53P495","TOT2",NODE,SDENCPTR)=$G(SDENT)
|
---|
| 236 | Q
|
---|