SDES844P ;ALB/MGD,TJB - SD*5.3*844 Post Init Routine ; May 24, 2023
;;5.3;SCHEDULING;**844**;AUG 13, 1993;Build 12
;;Per VHA Directive 6402, this routine should not be modified
;
Q
; Find 'COMMUNITY CARE CONSULT' IEN in file 40.7 then look in 409.85 to find all records
; that have that STOP CODE in fields 8.5 or 8.6 that do not have the CURRENT STATUS field 23 set to 'C'
; Any records found should have the following fields updated:
; Update fields:
; -CURRENT STATUS (field 23) (0;17) - Set to 'C' - This is a set and can have the values of C for CLOSED and O for OPEN
; -DISPOSITION (Field 21) (DIS;3) - use REMOVED/NON-VA, look in file 409.853 for the IEN of the disposition
; -DISPOSITIONED BY (Field 20) (DIS;2) - use POSTMASTER, look in the NEW PERSON file for the IEN
; -DATE DISPOSITIONED (Field 19) (DIS;1) - use date post install routine was run on this VistA
; -DISPOSITION CLOSED BY CLEANUP (Field 21.1) (DIS;4) - Set to 'Y' - this is a yes/no set field
;
EN ; Entry point for the post-install routine
D FIND,TASK
Q
;
FIND ;FIND THE IEN FOR "VS GUI NATIONAL"
N SDECDA,SDECDA1
D MES^XPDUTL("")
D MES^XPDUTL(" Updating SDEC SETTINGS file (#409.98)")
S SDECDA=0,SDECDA=$O(^SDEC(409.98,"B","VS GUI NATIONAL",SDECDA)) G:$G(SDECDA)="" NOFIND
D VERSION ;update GUI version number and date
Q
VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.42
S DA=SDECDA,DIE=409.98,DR="2///1.7.42;3///"_DT D ^DIE ;update VS GUI NATIONAL
K DIE,DR,DA
S SDECDA1=0,SDECDA1=$O(^SDEC(409.98,"B","VS GUI LOCAL",SDECDA1)) Q:$G(SDECDA1)="" ;get DA for the VS GUI LOCAL
S DA=SDECDA1,DIE=409.98,DR="2///1.7.42;3///"_DT D ^DIE ;update VS GUI LOCAL
K DIE,DR,DA
Q
;
NOFIND ;"VS GUI NATIONAL" NOT FOUND
D MES^XPDUTL(" VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)")
Q
;
TASK ;
D MES^XPDUTL("")
D MES^XPDUTL(" SD*5.3*844 Post-Install to fix Disposition records")
D MES^XPDUTL(" in the SDEC APPT REQUEST (#409.85) file is being")
D MES^XPDUTL(" queued to run in the background. Once it finishes")
D MES^XPDUTL(" a MailMan message will be sent to the installer to")
D MES^XPDUTL(" provide them a job completion status and data summary.")
D MES^XPDUTL("")
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*844 Post Install Routine"
D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="DISP^SDES844P",ZTSAVE("*")="" D ^%ZTLOAD
I $D(ZTSK) D
. D MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
. D MES^XPDUTL("")
I '$D(ZTSK) D
. D MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
. D MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
Q
;
DISP ; Disposition old OPEN Appointment Requests that have the STOP CODE "COMMUNITY CARE CONSULT"
N DISPIEN,FDA,ZN,TCNT,ERCNT,I
N CLNIEN,SDIEN,PMIEN,FLD85,FLD86 ; FLD85 => Field 8.5 from file 409.85, FLD86 => Field 8.6 from file 409.85
S TCNT=0,ERCNT=0
; Get IEN of CLINIC STOP (40.7)
S CLNIEN=$$FIND1^DIC(40.7,"","X","COMMUNITY CARE CONSULT","B","","ERROR")
I 'CLNIEN D Q
.S TEXT(1)="The COMMUNITY CARE CONSULT stop code could not be found in"
.S TEXT(2)="the CLINIC STOP (#40.7) file. Please contact the National"
.S TEXT(3)="Help Desk to report this issue."
.D MAIL
; Get IEN of the Disposition
S DISPIEN=$$FIND1^DIC(409.853,"","X","REMOVED/NON-VA CARE","B","","ERROR")
I 'DISPIEN D Q
.S TEXT(1)="The REMOVED/NON-VA CARE Disposition Reason could not be found"
.S TEXT(2)="in the SDEC DISPOSITION REASON (#409.853) file. Please contact the"
.S TEXT(3)="National Help Desk to report this issue."
.D MAIL
; Get IEN of POSTMASTER
S PMIEN=$$FIND1^DIC(200,"","X","POSTMASTER","B","","ERROR")
I 'PMIEN D Q
.S TEXT(1)="The POSTMASTER mail account could not be found"
.S TEXT(2)="in the NEW PERSON (#200) file. Please contact the"
.S TEXT(3)="National Help Desk to report this issue."
.D MAIL
; Walk SDEC APPT REQUEST file 409.85
;; Fields 8.5 and 8.6 contain the IEN of the stop codes
S SDIEN=0
; If the CURRENT STATUS (Field #23 [0;17]) is not CLOSED then look further in the record
F S SDIEN=$O(^SDEC(409.85,SDIEN)) Q:+SDIEN'>0 S ZN=$G(^SDEC(409.85,SDIEN,0)) I ZN]""&($P(ZN,U,17)'="C") D
. ; Grab fields 8.5 and 8.6
. S FLD85=$P(ZN,U,4),FLD86=$P($G(^SDEC(409.85,SDIEN,"SDREQ")),U,1)
. I FLD85=CLNIEN!(FLD86=CLNIEN) D
. . ; Found a record with the correct stop code; file the data for the record, mark it closed and increment the found count
. . S FDA(409.85,SDIEN_",",19)=$$DT^XLFDT
. . S FDA(409.85,SDIEN_",",20)=PMIEN
. . S FDA(409.85,SDIEN_",",21)=DISPIEN
. . S FDA(409.85,SDIEN_",",21.1)="Y"
. . S FDA(409.85,SDIEN_",",23)="C"
. . D FILE^DIE("","FDA","ERR84")
. . I '$D(ERR84) S TCNT=TCNT+1
. . E S ERCNT=ERCNT+1 S:ERCNT<5 ERCNT(ERCNT)=SDIEN
. . K FDA,ERR84
S TEXT(1)="The SD*5.3*844 post install has run to completion."
I ERCNT=0 S TEXT(2)="The data was reviewed and updated without any issues."
E S TEXT(2)="The data was reviewed and "_ERCNT_" errors where encountered."
S TEXT(3)="Total Appointment Requests updated: "_TCNT
I ERCNT>0 D
. S TEXT(4)=" "
. S TEXT(5)="Here are the IENs from 409.85 where errors were detected while"
. S TEXT(6)="processing records in SD*5.3*844 post install process run."
. S TEXT(7)="Errors found: "_ERCNT
. S TEXT(8)="IENs with errors: "
. S I=0 F S I=$O(ERCNT(I)) Q:I>5!(I="") S TEXT(8)=TEXT(8)_$S(I>1:", ",1:" ")_ERCNT(I)
D MAIL
Q
MAIL ;
; Get Station Number
;
N STANUM,MESS1,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM
S STANUM=$$KSP^XUPARAM("INST")_","
S STANUM=$$GET1^DIQ(4,STANUM,99)
S MESS1="Station: "_STANUM_" - "
;
; Send MailMan message
S XMDUZ=DUZ
S XMTEXT="TEXT("
S XMSUB=MESS1_"SD*5.3*844 - Post Install Update"
S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
D ^XMD
K TEXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES844P 5838 printed Apr 09, 2024@21:47:20 Page 2
SDES844P ;ALB/MGD,TJB - SD*5.3*844 Post Init Routine ; May 24, 2023
+1 ;;5.3;SCHEDULING;**844**;AUG 13, 1993;Build 12
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ; Find 'COMMUNITY CARE CONSULT' IEN in file 40.7 then look in 409.85 to find all records
+6 ; that have that STOP CODE in fields 8.5 or 8.6 that do not have the CURRENT STATUS field 23 set to 'C'
+7 ; Any records found should have the following fields updated:
+8 ; Update fields:
+9 ; -CURRENT STATUS (field 23) (0;17) - Set to 'C' - This is a set and can have the values of C for CLOSED and O for OPEN
+10 ; -DISPOSITION (Field 21) (DIS;3) - use REMOVED/NON-VA, look in file 409.853 for the IEN of the disposition
+11 ; -DISPOSITIONED BY (Field 20) (DIS;2) - use POSTMASTER, look in the NEW PERSON file for the IEN
+12 ; -DATE DISPOSITIONED (Field 19) (DIS;1) - use date post install routine was run on this VistA
+13 ; -DISPOSITION CLOSED BY CLEANUP (Field 21.1) (DIS;4) - Set to 'Y' - this is a yes/no set field
+14 ;
EN ; Entry point for the post-install routine
+1 DO FIND
DO TASK
+2 QUIT
+3 ;
FIND ;FIND THE IEN FOR "VS GUI NATIONAL"
+1 NEW SDECDA,SDECDA1
+2 DO MES^XPDUTL("")
+3 DO MES^XPDUTL(" Updating SDEC SETTINGS file (#409.98)")
+4 SET SDECDA=0
SET SDECDA=$ORDER(^SDEC(409.98,"B","VS GUI NATIONAL",SDECDA))
if $GET(SDECDA)=""
GOTO NOFIND
+5 ;update GUI version number and date
DO VERSION
+6 QUIT
VERSION ;SET THE NEW VERSION UPDATE IN SDEC SETTING FILE #409.98 TO 1.7.42
+1 ;update VS GUI NATIONAL
SET DA=SDECDA
SET DIE=409.98
SET DR="2///1.7.42;3///"_DT
DO ^DIE
+2 KILL DIE,DR,DA
+3 ;get DA for the VS GUI LOCAL
SET SDECDA1=0
SET SDECDA1=$ORDER(^SDEC(409.98,"B","VS GUI LOCAL",SDECDA1))
if $GET(SDECDA1)=""
QUIT
+4 ;update VS GUI LOCAL
SET DA=SDECDA1
SET DIE=409.98
SET DR="2///1.7.42;3///"_DT
DO ^DIE
+5 KILL DIE,DR,DA
+6 QUIT
+7 ;
NOFIND ;"VS GUI NATIONAL" NOT FOUND
+1 DO MES^XPDUTL(" VS GUI NATIONAL not found in the SDEC SETTINGS file (#409.98)")
+2 QUIT
+3 ;
TASK ;
+1 DO MES^XPDUTL("")
+2 DO MES^XPDUTL(" SD*5.3*844 Post-Install to fix Disposition records")
+3 DO MES^XPDUTL(" in the SDEC APPT REQUEST (#409.85) file is being")
+4 DO MES^XPDUTL(" queued to run in the background. Once it finishes")
+5 DO MES^XPDUTL(" a MailMan message will be sent to the installer to")
+6 DO MES^XPDUTL(" provide them a job completion status and data summary.")
+7 DO MES^XPDUTL("")
+8 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+9 SET ZTDESC="SD*5.3*844 Post Install Routine"
+10 DO NOW^%DTC
SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="DISP^SDES844P"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
+11 IF $DATA(ZTSK)
Begin DoDot:1
+12 DO MES^XPDUTL(" >>>Task "_ZTSK_" has been queued.")
+13 DO MES^XPDUTL("")
End DoDot:1
+14 IF '$DATA(ZTSK)
Begin DoDot:1
+15 DO MES^XPDUTL(" UNABLE TO QUEUE THIS JOB.")
+16 DO MES^XPDUTL(" Please contact the National Help Desk to report this issue.")
End DoDot:1
+17 QUIT
+18 ;
DISP ; Disposition old OPEN Appointment Requests that have the STOP CODE "COMMUNITY CARE CONSULT"
+1 NEW DISPIEN,FDA,ZN,TCNT,ERCNT,I
+2 ; FLD85 => Field 8.5 from file 409.85, FLD86 => Field 8.6 from file 409.85
NEW CLNIEN,SDIEN,PMIEN,FLD85,FLD86
+3 SET TCNT=0
SET ERCNT=0
+4 ; Get IEN of CLINIC STOP (40.7)
+5 SET CLNIEN=$$FIND1^DIC(40.7,"","X","COMMUNITY CARE CONSULT","B","","ERROR")
+6 IF 'CLNIEN
Begin DoDot:1
+7 SET TEXT(1)="The COMMUNITY CARE CONSULT stop code could not be found in"
+8 SET TEXT(2)="the CLINIC STOP (#40.7) file. Please contact the National"
+9 SET TEXT(3)="Help Desk to report this issue."
+10 DO MAIL
End DoDot:1
QUIT
+11 ; Get IEN of the Disposition
+12 SET DISPIEN=$$FIND1^DIC(409.853,"","X","REMOVED/NON-VA CARE","B","","ERROR")
+13 IF 'DISPIEN
Begin DoDot:1
+14 SET TEXT(1)="The REMOVED/NON-VA CARE Disposition Reason could not be found"
+15 SET TEXT(2)="in the SDEC DISPOSITION REASON (#409.853) file. Please contact the"
+16 SET TEXT(3)="National Help Desk to report this issue."
+17 DO MAIL
End DoDot:1
QUIT
+18 ; Get IEN of POSTMASTER
+19 SET PMIEN=$$FIND1^DIC(200,"","X","POSTMASTER","B","","ERROR")
+20 IF 'PMIEN
Begin DoDot:1
+21 SET TEXT(1)="The POSTMASTER mail account could not be found"
+22 SET TEXT(2)="in the NEW PERSON (#200) file. Please contact the"
+23 SET TEXT(3)="National Help Desk to report this issue."
+24 DO MAIL
End DoDot:1
QUIT
+25 ; Walk SDEC APPT REQUEST file 409.85
+26 ;; Fields 8.5 and 8.6 contain the IEN of the stop codes
+27 SET SDIEN=0
+28 ; If the CURRENT STATUS (Field #23 [0;17]) is not CLOSED then look further in the record
+29 FOR
SET SDIEN=$ORDER(^SDEC(409.85,SDIEN))
if +SDIEN'>0
QUIT
SET ZN=$GET(^SDEC(409.85,SDIEN,0))
IF ZN]""&($PIECE(ZN,U,17)'="C")
Begin DoDot:1
+30 ; Grab fields 8.5 and 8.6
+31 SET FLD85=$PIECE(ZN,U,4)
SET FLD86=$PIECE($GET(^SDEC(409.85,SDIEN,"SDREQ")),U,1)
+32 IF FLD85=CLNIEN!(FLD86=CLNIEN)
Begin DoDot:2
+33 ; Found a record with the correct stop code; file the data for the record, mark it closed and increment the found count
+34 SET FDA(409.85,SDIEN_",",19)=$$DT^XLFDT
+35 SET FDA(409.85,SDIEN_",",20)=PMIEN
+36 SET FDA(409.85,SDIEN_",",21)=DISPIEN
+37 SET FDA(409.85,SDIEN_",",21.1)="Y"
+38 SET FDA(409.85,SDIEN_",",23)="C"
+39 DO FILE^DIE("","FDA","ERR84")
+40 IF '$DATA(ERR84)
SET TCNT=TCNT+1
+41 IF '$TEST
SET ERCNT=ERCNT+1
if ERCNT<5
SET ERCNT(ERCNT)=SDIEN
+42 KILL FDA,ERR84
End DoDot:2
End DoDot:1
+43 SET TEXT(1)="The SD*5.3*844 post install has run to completion."
+44 IF ERCNT=0
SET TEXT(2)="The data was reviewed and updated without any issues."
+45 IF '$TEST
SET TEXT(2)="The data was reviewed and "_ERCNT_" errors where encountered."
+46 SET TEXT(3)="Total Appointment Requests updated: "_TCNT
+47 IF ERCNT>0
Begin DoDot:1
+48 SET TEXT(4)=" "
+49 SET TEXT(5)="Here are the IENs from 409.85 where errors were detected while"
+50 SET TEXT(6)="processing records in SD*5.3*844 post install process run."
+51 SET TEXT(7)="Errors found: "_ERCNT
+52 SET TEXT(8)="IENs with errors: "
+53 SET I=0
FOR
SET I=$ORDER(ERCNT(I))
if I>5!(I="")
QUIT
SET TEXT(8)=TEXT(8)_$SELECT(I>1:", ",1:" ")_ERCNT(I)
End DoDot:1
+54 DO MAIL
+55 QUIT
MAIL ;
+1 ; Get Station Number
+2 ;
+3 NEW STANUM,MESS1,XMTEXT,XMSUB,XMY,XMDUZ,DIFROM
+4 SET STANUM=$$KSP^XUPARAM("INST")_","
+5 SET STANUM=$$GET1^DIQ(4,STANUM,99)
+6 SET MESS1="Station: "_STANUM_" - "
+7 ;
+8 ; Send MailMan message
+9 SET XMDUZ=DUZ
+10 SET XMTEXT="TEXT("
+11 SET XMSUB=MESS1_"SD*5.3*844 - Post Install Update"
+12 SET XMDUZ=.5
SET XMY(DUZ)=""
SET XMY(XMDUZ)=""
+13 DO ^XMD
+14 KILL TEXT
+15 QUIT
