SD53P495 ;ALB/RBS - ENV/POST-INSTALL FOR PATCH SD*5.3*495 ; 5/2/07 12:24pm
;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
Q
ENV ;Environment check
S XPDABORT=""
;checks programmer variables
D PROGCHK(.XPDABORT)
;check if install is running
D ISRUNING(.XPDABORT)
I XPDABORT="" K XPDABORT
Q
POST ;Post-Install
D POST1
;Check for SCOUT file
I '$D(^ANUSB(626140)) D Q
. D NOFILE
D TASK
Q
POST1 ;Set parameter value
N SDDAYS,SDERR,SDPARM
S SDPARM="SDSC SITE PARAMETER",SDDAYS=30
D EN^XPAR("DIV",SDPARM,1,SDDAYS,.SDERR)
D BMES^XPDUTL("******")
I '$G(SDERR) D
. D MES^XPDUTL(SDPARM_" parameter set to "_SDDAYS_" days SUCCESSFULLY.")
E D
. D MES^XPDUTL(SDPARM_" parameter set FAILED.")
D MES^XPDUTL("******")
Q
START ;Background job entry point
N SDAIEN,SDANUSB,SDX,SDFDAIEN,SDARAY,SDERAY,SDSAVE
N SDTOT,SDTOT1,SDTOT2,SDTOT3,SDENCPTR,SDCKCNT,SDSTOP,SDENT,SDFIL,DFN
D XTMP
;seed var's if Re-Run
I $D(^XTMP("SD53P495","TOT")) D
. S SDTOT=+$G(^XTMP("SD53P495","TOT"))
. S SDTOT1=+$G(^XTMP("SD53P495","TOT1"))
. S SDTOT2=+$G(^XTMP("SD53P495","TOT2"))
. S SDTOT3=+$G(^XTMP("SD53P495","TOT3"))
. S (SDSAVE,SDENCPTR)=+$G(^XTMP("SD53P495","ENCOUNTER"))
E D
. S (SDAIEN,SDENCPTR,SDSAVE,SDTOT,SDTOT1,SDTOT2,SDTOT3)=0
S SDCKCNT=100,SDSTOP=0
F S SDENCPTR=$O(^ANUSB(626140,"B",SDENCPTR)) Q:'SDENCPTR D Q:SDSTOP
. S SDSAVE=SDENCPTR
. K SDANUSB,SDARAY,SDERAY,SDENT
. I +SDTOT#SDCKCNT=0,$$S^%ZTLOAD() S SDSTOP=1 Q
. S SDAIEN=$O(^ANUSB(626140,"B",SDENCPTR,""),-1)
. Q:'$G(SDAIEN)
. S SDANUSB=$G(^ANUSB(626140,SDAIEN,0))
. Q:'SDANUSB
. S SDTOT=SDTOT+1
. I $D(^SDSC(409.48,SDENCPTR,0)) S SDTOT3=SDTOT3+1 Q
. I '$$GETOE^SDOE(SDENCPTR) D Q
. . S DFN=$P(SDANUSB,U,11) D DEM^VADPT S DFN=$E(VADM(1),1,15)
. . S SDENT=DFN_" "_$$FMTE^XLFDT($P(SDANUSB,U,7),2)
. . D UPXTMP(SDENCPTR,"NO (O/P) ENCOUNTER RECORD (#409.68)",SDENT) S SDTOT2=SDTOT2+1
. D GETS^DIQ(626140,SDAIEN_",","**","I","SDARAY","SDERAY")
. I $D(SDERAY) D Q
. . S SDENT=$G(SDERAY("DIERR",1,"TEXT",1))
. . D UPXTMP(SDENCPTR,"NO (SCOUT) FILE DATA (#626140)",SDENT) S SDTOT2=SDTOT2+1
. S SDFIL=$$FILE(SDENCPTR,SDAIEN,.SDARAY)
. I '+SDFIL D Q
. . D UPXTMP(SDENCPTR,"FILING ERROR TO (#409.48)",$P(SDFIL,"^",2)) S SDTOT2=SDTOT2+1
. E D
. . S SDTOT1=SDTOT1+1
I SDSTOP D
. S ^XTMP("SD53P495","STOPPED")=$$NOW^XLFDT()
. S ZTSTOP=1
E D
. S ^XTMP("SD53P495","COMPLETED")=$$NOW^XLFDT()
S ^XTMP("SD53P495","ENCOUNTER")=SDSAVE
S ^XTMP("SD53P495","TOT")=SDTOT,^XTMP("SD53P495","TOT1")=SDTOT1
S ^XTMP("SD53P495","TOT2")=SDTOT2,^XTMP("SD53P495","TOT3")=SDTOT3
K ^XTMP("SD53P495","RUNNING") D KVA^VADPT
D SENDMSG(SDSTOP)
Q
FILE(SDENCPTR,SDAIEN,SDARAY) ;file new entry
; create #409.48 file
; Input:
; SDENCPTR - [required] O/P Encounter file pointer (#409.68)
; SDAIEN - [required] IEN of (#626140) record to convert
; SDARAY - [required] Array of Internal values of all fields
; Output:
; Function Value - returns 1 on success, 0 on failure and error msg
I '+$G(SDENCPTR)!'+$G(SDAIEN)!('$D(SDARAY)) Q 0
N SDERR,SDFDA,SDFLD,SDFDAIEN,SDI,SDIENS,SDNUM,SDSTR,SDSTR1,SDSUB
N DIC,DICR,DIE,DIERR,DD,DG,DO,DR,DA
; DINUM=X setup so new file IEN = O/P Encounter IEN
S SDFDAIEN(1)=SDENCPTR
; setup main fields
S SDIENS="+1,",SDAIEN=SDAIEN_","
S SDSTR=".01^.02^.03^.04^.05^.06^.07^.08^.09^.1^.11^.12"
F SDI=1:1:12 D
. S SDFLD=$P(SDSTR,U,SDI)
. S SDFDA(409.48,SDIENS,SDFLD)=$G(SDARAY(626140,SDAIEN,SDFLD,"I"))
S SDFDA(409.48,SDIENS,.13)=1 ;SCOUT was always a 1 (SC)
; setup fields of (#409.481) multiple
I $D(SDARAY(626140.01)) D
. S SDSTR1=".01^.02^.03^.04^.05^.06",SDNUM=1,(SDSUB,SDIENS)=""
. F S SDSUB=$O(SDARAY(626140.01,SDSUB)) Q:SDSUB="" D
. . S SDNUM=SDNUM+1
. . F SDI=1:1:6 S SDFLD=$P(SDSTR1,U,SDI) D
. . . S SDIENS="+"_SDNUM_",+1,"
. . . S SDFDA(409.481,SDIENS,SDFLD)=$G(SDARAY(626140.01,SDSUB,SDFLD,"I"))
D UPDATE^DIE("","SDFDA","SDFDAIEN","SDERR")
Q $S($D(SDERR):0,1:1)_"^"_$S($D(SDERR):$G(SDERR("DIERR",1,"TEXT",1)),1:"")
SENDMSG(SDSTOP) ;send MailMan msg to patch installer
N DIFROM,SDMSG,SDTXT,SDLN,XMY,XMDUZ,XMSUB,XMTEXT,XMDUN,XMZ
K ^TMP("SD53P495",$J)
S XMSUB="SD*5.3*495 (SCOUT) FILE CONVERSION REPORT"
S XMTEXT="^TMP(""SD53P495"",$J,",XMDUZ=.5,(XMY(DUZ),XMY(XMDUZ))=""
S SDLN=0
D ADD(.SDLN,"Patch: SD*5.3*495 Automated Service Connected Designation")
D ADD(.SDLN," "),ADD(.SDLN,"************")
D ADD(.SDLN,"The existing Class III (SCOUT) file, ANU SERVICE CONNECTED CHANGES (#626140),")
D ADD(.SDLN,"which contains O/P Encounter records that have been compiled for additional")
D ADD(.SDLN,"Service Connected (SC) review, has been used to create a new Class I file")
D ADD(.SDLN,"which will provide the same functionality.")
D ADD(.SDLN," ")
D ADD(.SDLN,"Only valid O/P Encounter records from the Class III (SCOUT) file,")
D ADD(.SDLN,"ANU SERVICE CONNECTED CHANGES (#626140), have been filed into")
D ADD(.SDLN,"the new SDSC SERVICE CONNECTED CHANGES (#409.48) file.")
D ADD(.SDLN," ")
D ADD(.SDLN,"The new Automated Service Connected Designation (ASCD) Menu Options")
D ADD(.SDLN,"enable user access to the O/P Encounter records in the (#409.48) file.")
D ADD(.SDLN,"************"),ADD(.SDLN," "),ADD(.SDLN," ")
D ADD(.SDLN,"SUMMARY OF PROCESSING RESULTS:")
D ADD(.SDLN,"==============================")
D ADD(.SDLN," ")
D ADD(.SDLN,"<<< The Class III (SCOUT) File Conversion has "_$S(+$G(SDSTOP):"NOT ",1:"")_"Completed. >>>")
I +$G(SDSTOP) D
. D ADD(.SDLN," Please restart the post-install process from the following")
. D ADD(.SDLN," programmer's prompt:")
. D ADD(.SDLN," D POST^SD53P495")
D ADD(.SDLN," "),ADD(.SDLN," ")
D ADD(.SDLN," DATE/TIME TASK STARTED: "_$$FMTE^XLFDT(+$G(^XTMP("SD53P495","START")),"P"))
I $G(SDSTOP) D
. D ADD(.SDLN," DATE/TIME TASK STOPPED: "_$$FMTE^XLFDT(+$G(^XTMP("SD53P495","STOPPED")),"P"))
E D
. D ADD(.SDLN,"DATE/TIME TASK COMPLETED: "_$$FMTE^XLFDT(+$G(^XTMP("SD53P495","COMPLETED")),"P"))
I $D(^XTMP("SD53P495","LAST RUN")) D
. D ADD(.SDLN," DATE/TIME LAST RUN: "_$$FMTE^XLFDT(+$G(^XTMP("SD53P495","LAST RUN")),"P"))
D ADD(.SDLN," "),ADD(.SDLN," ")
D ADD(.SDLN," TOTAL O/P ENCOUNTER RECORDS FOUND: "_+$G(^XTMP("SD53P495","TOT")))
I +$G(^XTMP("SD53P495","TOT3")) D
. D ADD(.SDLN," TOTAL RECORDS PREVIOUSLY CONVERTED: "_+$G(^XTMP("SD53P495","TOT3")))
D ADD(.SDLN," TOTAL O/P ENCOUNTER RECORDS CONVERTED: "_+$G(^XTMP("SD53P495","TOT1")))
D ADD(.SDLN,"TOTAL O/P ENCOUNTER RECORDS NOT CONVERTED: "_+$G(^XTMP("SD53P495","TOT2")))
I +$G(^XTMP("SD53P495","TOT2")) D
. D ADD(.SDLN," :")
. N SDSUB,SDIEN,SDENT
. S (SDSUB,SDIEN)=""
. F S SDSUB=$O(^XTMP("SD53P495","TOT2",SDSUB)) Q:SDSUB="" D
. . D ADD(.SDLN," REASON NOT CONVERTED: "_SDSUB)
. . D ADD(.SDLN," O/P ENCOUNTER IEN:")
. . F S SDIEN=$O(^XTMP("SD53P495","TOT2",SDSUB,SDIEN)) Q:'SDIEN D
. . . S SDENT=$E(^XTMP("SD53P495","TOT2",SDSUB,SDIEN),1,30)
. . . D ADD(.SDLN," : "_SDIEN_"-"_SDENT)
. . D ADD(.SDLN," :")
D ADD(.SDLN," <END OF REPORT> :")
D ^XMD
K ^TMP("SD53P495",$J)
Q
ADD(SDLN,SDTXT) ;add line
Q:$L(SDTXT)'>0
S SDLN=$G(SDLN)+1
S ^TMP("SD53P495",$J,SDLN)=SDTXT
Q
PROGCHK(XPDABORT) ;checks programmer variables
I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") D
. D BMES^XPDUTL("******")
. D MES^XPDUTL("Your programming variables are not set up properly.")
. D MES^XPDUTL("Installation aborted.")
. D MES^XPDUTL("******")
. S XPDABORT=2
Q
ISRUNING(XPDABORT) ;check if running
I +$G(^XTMP("SD53P495","RUNNING")) D
. D BMES^XPDUTL("******")
. D MES^XPDUTL("This patch is currently being Installed. Try later.")
. D MES^XPDUTL("Installation aborted...")
. D MES^XPDUTL("******")
. S XPDABORT=2
Q
NOFILE ;no File
D BMES^XPDUTL("******")
D MES^XPDUTL("The Class III (SCOUT) File Conversion is NOT necessary because")
D MES^XPDUTL("the ANU SERVICE CONNECTED CHANGES (#626140) file does not exist")
D MES^XPDUTL("on this system.")
D MES^XPDUTL("Post-Install process terminated...")
D MES^XPDUTL("******")
Q
TASK ;run TaskMan
N ZTSK,ZTDTH,ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTREQ,ZTSTOP,SDSTOP
S SDSTOP=+$G(^XTMP("SD53P495","STOPPED"))
S ZTRTN="START^SD53P495"
S ZTDESC="SD*5.3*495 (SCOUT) FILE CONVERSION PROCESSING"
S ZTIO="",ZTDTH=$H,ZTREQ="@",ZTSAVE("ZTREQ")=""
D ^%ZTLOAD
D BMES^XPDUTL("******")
I '$D(ZTSK) D
. D MES^XPDUTL("Unable to schedule TaskMan task to run the Class III (SCOUT) File")
. D MES^XPDUTL("Conversion.")
. D BMES^XPDUTL("Please re-run Post-Install routine POST^SD53P495 from")
. D MES^XPDUTL("the programmer prompt.")
. ;
E D
. D MES^XPDUTL("Task "_ZTSK_" has been "_$S(+SDSTOP:"Re-",1:"")_"started to run the Class III (SCOUT) File")
. D MES^XPDUTL("Conversion.")
. I SDSTOP D
. . D MES^XPDUTL(" <<< The last task run was STOPPED on "_$$FMTE^XLFDT(SDSTOP,"P")_". >>>")
. D BMES^XPDUTL("You will receive a MailMan message when this task is completed")
. D MES^XPDUTL("or if it has been manually stopped.")
D MES^XPDUTL("******")
Q
XTMP ;setup ^XTMP to control output for 90 days
I $D(^XTMP("SD53P495",0)) D
. S ^XTMP("SD53P495","LAST RUN")=$G(^XTMP("SD53P495","START"))
E D
. N SDX
. S SDX=$$FMADD^XLFDT($$NOW^XLFDT(),90)_U_$$NOW^XLFDT()
. S SDX=SDX_"^SD*5.3*495 (SCOUT) FILE CONVERSION PROCESSING"
. S ^XTMP("SD53P495",0)=SDX
S ^XTMP("SD53P495","START")=$$NOW^XLFDT()
S ^XTMP("SD53P495","RUNNING")="1"
Q
UPXTMP(SDENCPTR,NODE,SDENT) ;add to ^XTMP
; Input:
; SDENCPTR - Encounter IEN
; NODE - Unique subscript
; Output: none
Q:'$G(SDENCPTR)
I $G(NODE)="" S NODE="UNKNOWN"
S ^XTMP("SD53P495","TOT2",NODE,SDENCPTR)=$G(SDENT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53P495 9988 printed Apr 09, 2024@22:01:05 Page 2
SD53P495 ;ALB/RBS - ENV/POST-INSTALL FOR PATCH SD*5.3*495 ; 5/2/07 12:24pm
+1 ;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
+2 QUIT
ENV ;Environment check
+1 SET XPDABORT=""
+2 ;checks programmer variables
+3 DO PROGCHK(.XPDABORT)
+4 ;check if install is running
+5 DO ISRUNING(.XPDABORT)
+6 IF XPDABORT=""
KILL XPDABORT
+7 QUIT
POST ;Post-Install
+1 DO POST1
+2 ;Check for SCOUT file
+3 IF '$DATA(^ANUSB(626140))
Begin DoDot:1
+4 DO NOFILE
End DoDot:1
QUIT
+5 DO TASK
+6 QUIT
POST1 ;Set parameter value
+1 NEW SDDAYS,SDERR,SDPARM
+2 SET SDPARM="SDSC SITE PARAMETER"
SET SDDAYS=30
+3 DO EN^XPAR("DIV",SDPARM,1,SDDAYS,.SDERR)
+4 DO BMES^XPDUTL("******")
+5 IF '$GET(SDERR)
Begin DoDot:1
+6 DO MES^XPDUTL(SDPARM_" parameter set to "_SDDAYS_" days SUCCESSFULLY.")
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 DO MES^XPDUTL(SDPARM_" parameter set FAILED.")
End DoDot:1
+9 DO MES^XPDUTL("******")
+10 QUIT
START ;Background job entry point
+1 NEW SDAIEN,SDANUSB,SDX,SDFDAIEN,SDARAY,SDERAY,SDSAVE
+2 NEW SDTOT,SDTOT1,SDTOT2,SDTOT3,SDENCPTR,SDCKCNT,SDSTOP,SDENT,SDFIL,DFN
+3 DO XTMP
+4 ;seed var's if Re-Run
+5 IF $DATA(^XTMP("SD53P495","TOT"))
Begin DoDot:1
+6 SET SDTOT=+$GET(^XTMP("SD53P495","TOT"))
+7 SET SDTOT1=+$GET(^XTMP("SD53P495","TOT1"))
+8 SET SDTOT2=+$GET(^XTMP("SD53P495","TOT2"))
+9 SET SDTOT3=+$GET(^XTMP("SD53P495","TOT3"))
+10 SET (SDSAVE,SDENCPTR)=+$GET(^XTMP("SD53P495","ENCOUNTER"))
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET (SDAIEN,SDENCPTR,SDSAVE,SDTOT,SDTOT1,SDTOT2,SDTOT3)=0
End DoDot:1
+13 SET SDCKCNT=100
SET SDSTOP=0
+14 FOR
SET SDENCPTR=$ORDER(^ANUSB(626140,"B",SDENCPTR))
if 'SDENCPTR
QUIT
Begin DoDot:1
+15 SET SDSAVE=SDENCPTR
+16 KILL SDANUSB,SDARAY,SDERAY,SDENT
+17 IF +SDTOT#SDCKCNT=0
IF $$S^%ZTLOAD()
SET SDSTOP=1
QUIT
+18 SET SDAIEN=$ORDER(^ANUSB(626140,"B",SDENCPTR,""),-1)
+19 if '$GET(SDAIEN)
QUIT
+20 SET SDANUSB=$GET(^ANUSB(626140,SDAIEN,0))
+21 if 'SDANUSB
QUIT
+22 SET SDTOT=SDTOT+1
+23 IF $DATA(^SDSC(409.48,SDENCPTR,0))
SET SDTOT3=SDTOT3+1
QUIT
+24 IF '$$GETOE^SDOE(SDENCPTR)
Begin DoDot:2
+25 SET DFN=$PIECE(SDANUSB,U,11)
DO DEM^VADPT
SET DFN=$EXTRACT(VADM(1),1,15)
+26 SET SDENT=DFN_" "_$$FMTE^XLFDT($PIECE(SDANUSB,U,7),2)
+27 DO UPXTMP(SDENCPTR,"NO (O/P) ENCOUNTER RECORD (#409.68)",SDENT)
SET SDTOT2=SDTOT2+1
End DoDot:2
QUIT
+28 DO GETS^DIQ(626140,SDAIEN_",","**","I","SDARAY","SDERAY")
+29 IF $DATA(SDERAY)
Begin DoDot:2
+30 SET SDENT=$GET(SDERAY("DIERR",1,"TEXT",1))
+31 DO UPXTMP(SDENCPTR,"NO (SCOUT) FILE DATA (#626140)",SDENT)
SET SDTOT2=SDTOT2+1
End DoDot:2
QUIT
+32 SET SDFIL=$$FILE(SDENCPTR,SDAIEN,.SDARAY)
+33 IF '+SDFIL
Begin DoDot:2
+34 DO UPXTMP(SDENCPTR,"FILING ERROR TO (#409.48)",$PIECE(SDFIL,"^",2))
SET SDTOT2=SDTOT2+1
End DoDot:2
QUIT
+35 IF '$TEST
Begin DoDot:2
+36 SET SDTOT1=SDTOT1+1
End DoDot:2
End DoDot:1
if SDSTOP
QUIT
+37 IF SDSTOP
Begin DoDot:1
+38 SET ^XTMP("SD53P495","STOPPED")=$$NOW^XLFDT()
+39 SET ZTSTOP=1
End DoDot:1
+40 IF '$TEST
Begin DoDot:1
+41 SET ^XTMP("SD53P495","COMPLETED")=$$NOW^XLFDT()
End DoDot:1
+42 SET ^XTMP("SD53P495","ENCOUNTER")=SDSAVE
+43 SET ^XTMP("SD53P495","TOT")=SDTOT
SET ^XTMP("SD53P495","TOT1")=SDTOT1
+44 SET ^XTMP("SD53P495","TOT2")=SDTOT2
SET ^XTMP("SD53P495","TOT3")=SDTOT3
+45 KILL ^XTMP("SD53P495","RUNNING")
DO KVA^VADPT
+46 DO SENDMSG(SDSTOP)
+47 QUIT
FILE(SDENCPTR,SDAIEN,SDARAY) ;file new entry
+1 ; create #409.48 file
+2 ; Input:
+3 ; SDENCPTR - [required] O/P Encounter file pointer (#409.68)
+4 ; SDAIEN - [required] IEN of (#626140) record to convert
+5 ; SDARAY - [required] Array of Internal values of all fields
+6 ; Output:
+7 ; Function Value - returns 1 on success, 0 on failure and error msg
+8 IF '+$GET(SDENCPTR)!'+$GET(SDAIEN)!('$DATA(SDARAY))
QUIT 0
+9 NEW SDERR,SDFDA,SDFLD,SDFDAIEN,SDI,SDIENS,SDNUM,SDSTR,SDSTR1,SDSUB
+10 NEW DIC,DICR,DIE,DIERR,DD,DG,DO,DR,DA
+11 ; DINUM=X setup so new file IEN = O/P Encounter IEN
+12 SET SDFDAIEN(1)=SDENCPTR
+13 ; setup main fields
+14 SET SDIENS="+1,"
SET SDAIEN=SDAIEN_","
+15 SET SDSTR=".01^.02^.03^.04^.05^.06^.07^.08^.09^.1^.11^.12"
+16 FOR SDI=1:1:12
Begin DoDot:1
+17 SET SDFLD=$PIECE(SDSTR,U,SDI)
+18 SET SDFDA(409.48,SDIENS,SDFLD)=$GET(SDARAY(626140,SDAIEN,SDFLD,"I"))
End DoDot:1
+19 ;SCOUT was always a 1 (SC)
SET SDFDA(409.48,SDIENS,.13)=1
+20 ; setup fields of (#409.481) multiple
+21 IF $DATA(SDARAY(626140.01))
Begin DoDot:1
+22 SET SDSTR1=".01^.02^.03^.04^.05^.06"
SET SDNUM=1
SET (SDSUB,SDIENS)=""
+23 FOR
SET SDSUB=$ORDER(SDARAY(626140.01,SDSUB))
if SDSUB=""
QUIT
Begin DoDot:2
+24 SET SDNUM=SDNUM+1
+25 FOR SDI=1:1:6
SET SDFLD=$PIECE(SDSTR1,U,SDI)
Begin DoDot:3
+26 SET SDIENS="+"_SDNUM_",+1,"
+27 SET SDFDA(409.481,SDIENS,SDFLD)=$GET(SDARAY(626140.01,SDSUB,SDFLD,"I"))
End DoDot:3
End DoDot:2
End DoDot:1
+28 DO UPDATE^DIE("","SDFDA","SDFDAIEN","SDERR")
+29 QUIT $SELECT($DATA(SDERR):0,1:1)_"^"_$SELECT($DATA(SDERR):$GET(SDERR("DIERR",1,"TEXT",1)),1:"")
SENDMSG(SDSTOP) ;send MailMan msg to patch installer
+1 NEW DIFROM,SDMSG,SDTXT,SDLN,XMY,XMDUZ,XMSUB,XMTEXT,XMDUN,XMZ
+2 KILL ^TMP("SD53P495",$JOB)
+3 SET XMSUB="SD*5.3*495 (SCOUT) FILE CONVERSION REPORT"
+4 SET XMTEXT="^TMP(""SD53P495"",$J,"
SET XMDUZ=.5
SET (XMY(DUZ),XMY(XMDUZ))=""
+5 SET SDLN=0
+6 DO ADD(.SDLN,"Patch: SD*5.3*495 Automated Service Connected Designation")
+7 DO ADD(.SDLN," ")
DO ADD(.SDLN,"************")
+8 DO ADD(.SDLN,"The existing Class III (SCOUT) file, ANU SERVICE CONNECTED CHANGES (#626140),")
+9 DO ADD(.SDLN,"which contains O/P Encounter records that have been compiled for additional")
+10 DO ADD(.SDLN,"Service Connected (SC) review, has been used to create a new Class I file")
+11 DO ADD(.SDLN,"which will provide the same functionality.")
+12 DO ADD(.SDLN," ")
+13 DO ADD(.SDLN,"Only valid O/P Encounter records from the Class III (SCOUT) file,")
+14 DO ADD(.SDLN,"ANU SERVICE CONNECTED CHANGES (#626140), have been filed into")
+15 DO ADD(.SDLN,"the new SDSC SERVICE CONNECTED CHANGES (#409.48) file.")
+16 DO ADD(.SDLN," ")
+17 DO ADD(.SDLN,"The new Automated Service Connected Designation (ASCD) Menu Options")
+18 DO ADD(.SDLN,"enable user access to the O/P Encounter records in the (#409.48) file.")
+19 DO ADD(.SDLN,"************")
DO ADD(.SDLN," ")
DO ADD(.SDLN," ")
+20 DO ADD(.SDLN,"SUMMARY OF PROCESSING RESULTS:")
+21 DO ADD(.SDLN,"==============================")
+22 DO ADD(.SDLN," ")
+23 DO ADD(.SDLN,"<<< The Class III (SCOUT) File Conversion has "_$SELECT(+$GET(SDSTOP):"NOT ",1:"")_"Completed. >>>")
+24 IF +$GET(SDSTOP)
Begin DoDot:1
+25 DO ADD(.SDLN," Please restart the post-install process from the following")
+26 DO ADD(.SDLN," programmer's prompt:")
+27 DO ADD(.SDLN," D POST^SD53P495")
End DoDot:1
+28 DO ADD(.SDLN," ")
DO ADD(.SDLN," ")
+29 DO ADD(.SDLN," DATE/TIME TASK STARTED: "_$$FMTE^XLFDT(+$GET(^XTMP("SD53P495","START")),"P"))
+30 IF $GET(SDSTOP)
Begin DoDot:1
+31 DO ADD(.SDLN," DATE/TIME TASK STOPPED: "_$$FMTE^XLFDT(+$GET(^XTMP("SD53P495","STOPPED")),"P"))
End DoDot:1
+32 IF '$TEST
Begin DoDot:1
+33 DO ADD(.SDLN,"DATE/TIME TASK COMPLETED: "_$$FMTE^XLFDT(+$GET(^XTMP("SD53P495","COMPLETED")),"P"))
End DoDot:1
+34 IF $DATA(^XTMP("SD53P495","LAST RUN"))
Begin DoDot:1
+35 DO ADD(.SDLN," DATE/TIME LAST RUN: "_$$FMTE^XLFDT(+$GET(^XTMP("SD53P495","LAST RUN")),"P"))
End DoDot:1
+36 DO ADD(.SDLN," ")
DO ADD(.SDLN," ")
+37 DO ADD(.SDLN," TOTAL O/P ENCOUNTER RECORDS FOUND: "_+$GET(^XTMP("SD53P495","TOT")))
+38 IF +$GET(^XTMP("SD53P495","TOT3"))
Begin DoDot:1
+39 DO ADD(.SDLN," TOTAL RECORDS PREVIOUSLY CONVERTED: "_+$GET(^XTMP("SD53P495","TOT3")))
End DoDot:1
+40 DO ADD(.SDLN," TOTAL O/P ENCOUNTER RECORDS CONVERTED: "_+$GET(^XTMP("SD53P495","TOT1")))
+41 DO ADD(.SDLN,"TOTAL O/P ENCOUNTER RECORDS NOT CONVERTED: "_+$GET(^XTMP("SD53P495","TOT2")))
+42 IF +$GET(^XTMP("SD53P495","TOT2"))
Begin DoDot:1
+43 DO ADD(.SDLN," :")
+44 NEW SDSUB,SDIEN,SDENT
+45 SET (SDSUB,SDIEN)=""
+46 FOR
SET SDSUB=$ORDER(^XTMP("SD53P495","TOT2",SDSUB))
if SDSUB=""
QUIT
Begin DoDot:2
+47 DO ADD(.SDLN," REASON NOT CONVERTED: "_SDSUB)
+48 DO ADD(.SDLN," O/P ENCOUNTER IEN:")
+49 FOR
SET SDIEN=$ORDER(^XTMP("SD53P495","TOT2",SDSUB,SDIEN))
if 'SDIEN
QUIT
Begin DoDot:3
+50 SET SDENT=$EXTRACT(^XTMP("SD53P495","TOT2",SDSUB,SDIEN),1,30)
+51 DO ADD(.SDLN," : "_SDIEN_"-"_SDENT)
End DoDot:3
+52 DO ADD(.SDLN," :")
End DoDot:2
End DoDot:1
+53 DO ADD(.SDLN," <END OF REPORT> :")
+54 DO ^XMD
+55 KILL ^TMP("SD53P495",$JOB)
+56 QUIT
ADD(SDLN,SDTXT) ;add line
+1 if $LENGTH(SDTXT)'>0
QUIT
+2 SET SDLN=$GET(SDLN)+1
+3 SET ^TMP("SD53P495",$JOB,SDLN)=SDTXT
+4 QUIT
PROGCHK(XPDABORT) ;checks programmer variables
+1 IF '$GET(DUZ)!($GET(DUZ(0))'="@")!('$GET(DT))!($GET(U)'="^")
Begin DoDot:1
+2 DO BMES^XPDUTL("******")
+3 DO MES^XPDUTL("Your programming variables are not set up properly.")
+4 DO MES^XPDUTL("Installation aborted.")
+5 DO MES^XPDUTL("******")
+6 SET XPDABORT=2
End DoDot:1
+7 QUIT
ISRUNING(XPDABORT) ;check if running
+1 IF +$GET(^XTMP("SD53P495","RUNNING"))
Begin DoDot:1
+2 DO BMES^XPDUTL("******")
+3 DO MES^XPDUTL("This patch is currently being Installed. Try later.")
+4 DO MES^XPDUTL("Installation aborted...")
+5 DO MES^XPDUTL("******")
+6 SET XPDABORT=2
End DoDot:1
+7 QUIT
NOFILE ;no File
+1 DO BMES^XPDUTL("******")
+2 DO MES^XPDUTL("The Class III (SCOUT) File Conversion is NOT necessary because")
+3 DO MES^XPDUTL("the ANU SERVICE CONNECTED CHANGES (#626140) file does not exist")
+4 DO MES^XPDUTL("on this system.")
+5 DO MES^XPDUTL("Post-Install process terminated...")
+6 DO MES^XPDUTL("******")
+7 QUIT
TASK ;run TaskMan
+1 NEW ZTSK,ZTDTH,ZTRTN,ZTDESC,ZTIO,ZTSAVE,ZTREQ,ZTSTOP,SDSTOP
+2 SET SDSTOP=+$GET(^XTMP("SD53P495","STOPPED"))
+3 SET ZTRTN="START^SD53P495"
+4 SET ZTDESC="SD*5.3*495 (SCOUT) FILE CONVERSION PROCESSING"
+5 SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTREQ="@"
SET ZTSAVE("ZTREQ")=""
+6 DO ^%ZTLOAD
+7 DO BMES^XPDUTL("******")
+8 IF '$DATA(ZTSK)
Begin DoDot:1
+9 DO MES^XPDUTL("Unable to schedule TaskMan task to run the Class III (SCOUT) File")
+10 DO MES^XPDUTL("Conversion.")
+11 DO BMES^XPDUTL("Please re-run Post-Install routine POST^SD53P495 from")
+12 DO MES^XPDUTL("the programmer prompt.")
+13 ;
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 DO MES^XPDUTL("Task "_ZTSK_" has been "_$SELECT(+SDSTOP:"Re-",1:"")_"started to run the Class III (SCOUT) File")
+16 DO MES^XPDUTL("Conversion.")
+17 IF SDSTOP
Begin DoDot:2
+18 DO MES^XPDUTL(" <<< The last task run was STOPPED on "_$$FMTE^XLFDT(SDSTOP,"P")_". >>>")
End DoDot:2
+19 DO BMES^XPDUTL("You will receive a MailMan message when this task is completed")
+20 DO MES^XPDUTL("or if it has been manually stopped.")
End DoDot:1
+21 DO MES^XPDUTL("******")
+22 QUIT
XTMP ;setup ^XTMP to control output for 90 days
+1 IF $DATA(^XTMP("SD53P495",0))
Begin DoDot:1
+2 SET ^XTMP("SD53P495","LAST RUN")=$GET(^XTMP("SD53P495","START"))
End DoDot:1
+3 IF '$TEST
Begin DoDot:1
+4 NEW SDX
+5 SET SDX=$$FMADD^XLFDT($$NOW^XLFDT(),90)_U_$$NOW^XLFDT()
+6 SET SDX=SDX_"^SD*5.3*495 (SCOUT) FILE CONVERSION PROCESSING"
+7 SET ^XTMP("SD53P495",0)=SDX
End DoDot:1
+8 SET ^XTMP("SD53P495","START")=$$NOW^XLFDT()
+9 SET ^XTMP("SD53P495","RUNNING")="1"
+10 QUIT
UPXTMP(SDENCPTR,NODE,SDENT) ;add to ^XTMP
+1 ; Input:
+2 ; SDENCPTR - Encounter IEN
+3 ; NODE - Unique subscript
+4 ; Output: none
+5 if '$GET(SDENCPTR)
QUIT
+6 IF $GET(NODE)=""
SET NODE="UNKNOWN"
+7 SET ^XTMP("SD53P495","TOT2",NODE,SDENCPTR)=$GET(SDENT)
+8 QUIT
