SDES842P ;ALB/MGD,LAB - SD*5.3*842 Post Init Routine ; Mar 10, 2023
;;5.3;SCHEDULING;**842**;AUG 13, 1993;Build 17
;;Per VHA Directive 6402, this routine should not be modified
;
D FIND,TASK,TASK2
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.40
S DA=SDECDA,DIE=409.98,DR="2///1.7.40;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.40;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*842 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*842 Post Install Routine"
D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="DISP^SDES842P",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
;
TASK2 ;
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC="SD*5.3*842 - Post Install Report Routine"
D NOW^%DTC S ZTDTH=X,ZTIO="",ZTRTN="DATAREPORT^SDES842P",ZTSAVE("*")="" D ^%ZTLOAD
Q
;
DISP ; Disposition old Appointment Requests
N APPTIEN,ARIEN,CANCREAS,DATA0,DATA2,DISP,DISPIEN,FDA,IEN627,REOPEN,STARTTIME,TCNT
S TCNT=0
S IEN627=$$FIND1^DIC(9.7,"","X","SD*5.3*627","B","","ERROR")
I 'IEN627 D Q
.S TEXT(1)="The installation record for patch SD*5.3*627 could not be found"
.S TEXT(2)="in the INSTALL (#9.7) file. Please contact the National Help Desk"
.S TEXT(3)="to report this issue."
.D MAIL
S STARTTIME=$$GET1^DIQ(9.7,IEN627,17,"I")
I STARTTIME="" D Q
.S TEXT(1)="The installation complete time for patch SD*5.3*627 could not be found"
.S TEXT(2)="in the INSTALL (#9.7) file. Please contact the National Help Desk"
.S TEXT(3)="to report this issue."
.D MAIL
S DISPIEN=$$FIND1^DIC(409.853,"","X","CANCELLED NOT RE-OPENED","B","","ERROR")
I 'DISPIEN D Q
.S TEXT(1)="The CANCELLED NOT RE-OPENED 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
S STARTTIME=STARTTIME-.000001
F S STARTTIME=$O(^SDEC(409.84,"B",STARTTIME)) Q:'STARTTIME D
.S APPTIEN=""
.F S APPTIEN=$O(^SDEC(409.84,"B",STARTTIME,APPTIEN)) Q:'APPTIEN D
..S DATA0=$G(^SDEC(409.84,APPTIEN,0))
..; Quit is this appt is NOT cancelled
..S CANCREAS=$P(DATA0,U,22)
..Q:'CANCREAS
..; Quit it Appt Req should NOT be re-opened
..S REOPEN=$$GET1^DIQ(409.2,CANCREAS,5,"I")
..Q:REOPEN ; 1=re-open 0=don't re-open
..; Quit if this appointment doesn't point back to #409.85
..S DATA2=$P($G(^SDEC(409.84,APPTIEN,2)),"^",1)
..Q:DATA2'["409.85"
..S ARIEN=$P(DATA2,";",1)
..Q:'ARIEN
..; Quit if this Appt Req has already been Dispositioned
..Q:$P($G(^SDEC(409.85,ARIEN,"DIS")),U,3)
..; Set Disposition fields for update
..S FDA(409.85,ARIEN_",",19)=$P($$GET1^DIQ(409.84,APPTIEN,.12,"I"),".",1) ; FIX TO JUST BE A DATE
..S FDA(409.85,ARIEN_",",20)=$$GET1^DIQ(409.84,APPTIEN,.121,"I")
..S FDA(409.85,ARIEN_",",21)=DISPIEN
..D FILE^DIE("","FDA","ERR84")
..I '$D(ERR84) S TCNT=TCNT+1
..K FDA,ERR84
S TEXT(1)="The SD*5.3*842 post install has run to completion."
S TEXT(2)="The data was reviewed and updated without any issues."
S TEXT(3)="Total Appoint Requests updated: "_TCNT
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*842 - Post Install Update"
S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
D ^XMD
K TEXT
Q
MAIL2 ;
; Appointment vs request data report
;
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="^XTMP(""SDES842P"","
S XMSUB=MESS1_"SD*5.3*842 - Post Install Data Report"
S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
S XMY("BARBER.LORI@DOMAIN.EXT")=""
S XMY("DILL.MATT@DOMAIN.EXT")=""
S XMY("REESE,DARRYL M@DOMAIN.EXT")=""
D ^XMD
K TEXT
Q
DATAREPORT ;
N APPTIEN,CHECKIN,CANCELDTTM,STARTTM,POP,CNT,PURGEDT,TEXTCNT
S PURGEDT=$$FMADD^XLFDT(DT,5)
S ^XTMP("SDES842P",0)=PURGEDT_"^"_DT_"^842 Post Install Data report"
S CNT=0
S TEXTCNT=0
S STARTTM=3221014
F S STARTTM=$O(^SDEC(409.84,"B",STARTTM)) Q:(STARTTM="") D
. S APPTIEN=""
. S POP=0
. F S APPTIEN=$O(^SDEC(409.84,"B",STARTTM,APPTIEN)) Q:(APPTIEN="")!POP D
.. S CHECKIN=$$GET1^DIQ(409.84,APPTIEN_",",.03)
.. S CANCELDTTM=$$GET1^DIQ(409.84,APPTIEN_",",.12)
.. S POP=(CHECKIN'="")!(CANCELDTTM'="")
.. Q:POP
.. ;Continue checking
.. S APPTDFN=$$GET1^DIQ(409.84,APPTIEN_",",.05,"I")
.. S APPTREQTYP=$$GET1^DIQ(409.84,APPTIEN_",",.22,"E")
.. S APPTREQINFO=$$GET1^DIQ(409.84,APPTIEN_",",.22,"I")
.. D:(APPTREQTYP="APPT") APPT(APPTREQINFO,APPTIEN,APPTDFN,APPTREQTYP)
.. D:(APPTREQTYP="CONSULT") CONSULT(APPTREQINFO,APPTIEN,APPTDFN,APPTREQTYP)
S ^XTMP("SDES842P",(TEXTCNT+1))="Total = "_CNT
D MAIL2
Q
;
APPT(APPTREQINFO,APPTIEN,APPTDFN,APPTREQTYP) ;
S REQIEN=$P(APPTREQINFO,";",1)
S REQPATDFN=$$GET1^DIQ(409.85,REQIEN_",",.01,"I")
Q:APPTDFN=REQPATDFN
S REQPATIENT=$$GET1^DIQ(409.85,REQIEN_",",.01,"E")
S PATIENTNAME=$$GET1^DIQ(409.84,APPTIEN_",",.05,"E")
D REPORT(REQIEN,APPTREQTYP,APPTDFN,PATIENTNAME,REQPATDFN,APPTIEN,REQPATIENT)
;
Q
CONSULT(APPTREQINFO,APPTIEN,APPTDFN,APPTREQTYP) ;
N CONSULTIEN,CONSULTPATDFN,CONSULTPATIENT
S CONSULTIEN=$P(APPTREQINFO,";",1)
S CONSULTPATDFN=$$GET1^DIQ(123,CONSULTIEN_",",.02,"I")
Q:APPTDFN=CONSULTPATDFN
S CONSULTPATIENT=$$GET1^DIQ(123,CONSULTIEN_",",.02,"E")
;
S PATIENTNAME=$$GET1^DIQ(409.84,APPTIEN_",",.05,"E")
D REPORT(CONSULTIEN,APPTREQTYP,APPTDFN,PATIENTNAME,CONSULTPATDFN,APPTIEN,CONSULTPATIENT)
Q
;
REPORT(REQIEN,APPTREQTYP,APPTPATDFN,PATIENTNAME,REQPATDFN,APPTIEN,REQPATIENT) ;
S CNT=CNT+1
S TEXTCNT=TEXTCNT+1
S ^XTMP("SDES842P",TEXTCNT)=" Request to be reviewed : "_REQIEN_" "_APPTREQTYP
S TEXTCNT=TEXTCNT+1
S ^XTMP("SDES842P",TEXTCNT)=" Appointment : "_APPTIEN
S TEXTCNT=TEXTCNT+1
S ^XTMP("SDES842P",TEXTCNT)=" Appointment Date/Time : "_$$GET1^DIQ(409.84,APPTIEN_",",.01,"E")
S TEXTCNT=TEXTCNT+1
S ^XTMP("SDES842P",TEXTCNT)=" Appointment Made Date : "_$$GET1^DIQ(409.84,APPTIEN_",",.09,"E")
S TEXTCNT=TEXTCNT+1
S ^XTMP("SDES842P",TEXTCNT)=" Patient on appointment : "_APPTDFN_" "_$$LAST4SSN^SDESINPUTVALUTL(APPTPATDFN)
S TEXTCNT=TEXTCNT+1
S ^XTMP("SDES842P",TEXTCNT)=" Patient on request : "_REQPATDFN_" "_$$LAST4SSN^SDESINPUTVALUTL(REQPATDFN)
S TEXTCNT=TEXTCNT+1
S ^XTMP("SDES842P",TEXTCNT)=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES842P 7831 printed Sep 23, 2025@20:31:45 Page 2
SDES842P ;ALB/MGD,LAB - SD*5.3*842 Post Init Routine ; Mar 10, 2023
+1 ;;5.3;SCHEDULING;**842**;AUG 13, 1993;Build 17
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 DO FIND
DO TASK
DO TASK2
+5 QUIT
+6 ;
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.40
+1 ;update VS GUI NATIONAL
SET DA=SDECDA
SET DIE=409.98
SET DR="2///1.7.40;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.40;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*842 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*842 Post Install Routine"
+10 DO NOW^%DTC
SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="DISP^SDES842P"
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 ;
TASK2 ;
+1 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+2 SET ZTDESC="SD*5.3*842 - Post Install Report Routine"
+3 DO NOW^%DTC
SET ZTDTH=X
SET ZTIO=""
SET ZTRTN="DATAREPORT^SDES842P"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
+4 QUIT
+5 ;
DISP ; Disposition old Appointment Requests
+1 NEW APPTIEN,ARIEN,CANCREAS,DATA0,DATA2,DISP,DISPIEN,FDA,IEN627,REOPEN,STARTTIME,TCNT
+2 SET TCNT=0
+3 SET IEN627=$$FIND1^DIC(9.7,"","X","SD*5.3*627","B","","ERROR")
+4 IF 'IEN627
Begin DoDot:1
+5 SET TEXT(1)="The installation record for patch SD*5.3*627 could not be found"
+6 SET TEXT(2)="in the INSTALL (#9.7) file. Please contact the National Help Desk"
+7 SET TEXT(3)="to report this issue."
+8 DO MAIL
End DoDot:1
QUIT
+9 SET STARTTIME=$$GET1^DIQ(9.7,IEN627,17,"I")
+10 IF STARTTIME=""
Begin DoDot:1
+11 SET TEXT(1)="The installation complete time for patch SD*5.3*627 could not be found"
+12 SET TEXT(2)="in the INSTALL (#9.7) file. Please contact the National Help Desk"
+13 SET TEXT(3)="to report this issue."
+14 DO MAIL
End DoDot:1
QUIT
+15 SET DISPIEN=$$FIND1^DIC(409.853,"","X","CANCELLED NOT RE-OPENED","B","","ERROR")
+16 IF 'DISPIEN
Begin DoDot:1
+17 SET TEXT(1)="The CANCELLED NOT RE-OPENED Disposition Reason could not be found"
+18 SET TEXT(2)="in the SDEC DISPOSITION REASON (#409.853) file. Please contact the"
+19 SET TEXT(3)="National Help Desk to report this issue."
+20 DO MAIL
End DoDot:1
QUIT
+21 SET STARTTIME=STARTTIME-.000001
+22 FOR
SET STARTTIME=$ORDER(^SDEC(409.84,"B",STARTTIME))
if 'STARTTIME
QUIT
Begin DoDot:1
+23 SET APPTIEN=""
+24 FOR
SET APPTIEN=$ORDER(^SDEC(409.84,"B",STARTTIME,APPTIEN))
if 'APPTIEN
QUIT
Begin DoDot:2
+25 SET DATA0=$GET(^SDEC(409.84,APPTIEN,0))
+26 ; Quit is this appt is NOT cancelled
+27 SET CANCREAS=$PIECE(DATA0,U,22)
+28 if 'CANCREAS
QUIT
+29 ; Quit it Appt Req should NOT be re-opened
+30 SET REOPEN=$$GET1^DIQ(409.2,CANCREAS,5,"I")
+31 ; 1=re-open 0=don't re-open
if REOPEN
QUIT
+32 ; Quit if this appointment doesn't point back to #409.85
+33 SET DATA2=$PIECE($GET(^SDEC(409.84,APPTIEN,2)),"^",1)
+34 if DATA2'["409.85"
QUIT
+35 SET ARIEN=$PIECE(DATA2,";",1)
+36 if 'ARIEN
QUIT
+37 ; Quit if this Appt Req has already been Dispositioned
+38 if $PIECE($GET(^SDEC(409.85,ARIEN,"DIS")),U,3)
QUIT
+39 ; Set Disposition fields for update
+40 ; FIX TO JUST BE A DATE
SET FDA(409.85,ARIEN_",",19)=$PIECE($$GET1^DIQ(409.84,APPTIEN,.12,"I"),".",1)
+41 SET FDA(409.85,ARIEN_",",20)=$$GET1^DIQ(409.84,APPTIEN,.121,"I")
+42 SET FDA(409.85,ARIEN_",",21)=DISPIEN
+43 DO FILE^DIE("","FDA","ERR84")
+44 IF '$DATA(ERR84)
SET TCNT=TCNT+1
+45 KILL FDA,ERR84
End DoDot:2
End DoDot:1
+46 SET TEXT(1)="The SD*5.3*842 post install has run to completion."
+47 SET TEXT(2)="The data was reviewed and updated without any issues."
+48 SET TEXT(3)="Total Appoint Requests updated: "_TCNT
+49 DO MAIL
+50 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*842 - Post Install Update"
+12 SET XMDUZ=.5
SET XMY(DUZ)=""
SET XMY(XMDUZ)=""
+13 DO ^XMD
+14 KILL TEXT
+15 QUIT
MAIL2 ;
+1 ; Appointment vs request data report
+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="^XTMP(""SDES842P"","
+11 SET XMSUB=MESS1_"SD*5.3*842 - Post Install Data Report"
+12 SET XMDUZ=.5
SET XMY(DUZ)=""
SET XMY(XMDUZ)=""
+13 SET XMY("BARBER.LORI@DOMAIN.EXT")=""
+14 SET XMY("DILL.MATT@DOMAIN.EXT")=""
+15 SET XMY("REESE,DARRYL M@DOMAIN.EXT")=""
+16 DO ^XMD
+17 KILL TEXT
+18 QUIT
DATAREPORT ;
+1 NEW APPTIEN,CHECKIN,CANCELDTTM,STARTTM,POP,CNT,PURGEDT,TEXTCNT
+2 SET PURGEDT=$$FMADD^XLFDT(DT,5)
+3 SET ^XTMP("SDES842P",0)=PURGEDT_"^"_DT_"^842 Post Install Data report"
+4 SET CNT=0
+5 SET TEXTCNT=0
+6 SET STARTTM=3221014
+7 FOR
SET STARTTM=$ORDER(^SDEC(409.84,"B",STARTTM))
if (STARTTM="")
QUIT
Begin DoDot:1
+8 SET APPTIEN=""
+9 SET POP=0
+10 FOR
SET APPTIEN=$ORDER(^SDEC(409.84,"B",STARTTM,APPTIEN))
if (APPTIEN="")!POP
QUIT
Begin DoDot:2
+11 SET CHECKIN=$$GET1^DIQ(409.84,APPTIEN_",",.03)
+12 SET CANCELDTTM=$$GET1^DIQ(409.84,APPTIEN_",",.12)
+13 SET POP=(CHECKIN'="")!(CANCELDTTM'="")
+14 if POP
QUIT
+15 ;Continue checking
+16 SET APPTDFN=$$GET1^DIQ(409.84,APPTIEN_",",.05,"I")
+17 SET APPTREQTYP=$$GET1^DIQ(409.84,APPTIEN_",",.22,"E")
+18 SET APPTREQINFO=$$GET1^DIQ(409.84,APPTIEN_",",.22,"I")
+19 if (APPTREQTYP="APPT")
DO APPT(APPTREQINFO,APPTIEN,APPTDFN,APPTREQTYP)
+20 if (APPTREQTYP="CONSULT")
DO CONSULT(APPTREQINFO,APPTIEN,APPTDFN,APPTREQTYP)
End DoDot:2
End DoDot:1
+21 SET ^XTMP("SDES842P",(TEXTCNT+1))="Total = "_CNT
+22 DO MAIL2
+23 QUIT
+24 ;
APPT(APPTREQINFO,APPTIEN,APPTDFN,APPTREQTYP) ;
+1 SET REQIEN=$PIECE(APPTREQINFO,";",1)
+2 SET REQPATDFN=$$GET1^DIQ(409.85,REQIEN_",",.01,"I")
+3 if APPTDFN=REQPATDFN
QUIT
+4 SET REQPATIENT=$$GET1^DIQ(409.85,REQIEN_",",.01,"E")
+5 SET PATIENTNAME=$$GET1^DIQ(409.84,APPTIEN_",",.05,"E")
+6 DO REPORT(REQIEN,APPTREQTYP,APPTDFN,PATIENTNAME,REQPATDFN,APPTIEN,REQPATIENT)
+7 ;
+8 QUIT
CONSULT(APPTREQINFO,APPTIEN,APPTDFN,APPTREQTYP) ;
+1 NEW CONSULTIEN,CONSULTPATDFN,CONSULTPATIENT
+2 SET CONSULTIEN=$PIECE(APPTREQINFO,";",1)
+3 SET CONSULTPATDFN=$$GET1^DIQ(123,CONSULTIEN_",",.02,"I")
+4 if APPTDFN=CONSULTPATDFN
QUIT
+5 SET CONSULTPATIENT=$$GET1^DIQ(123,CONSULTIEN_",",.02,"E")
+6 ;
+7 SET PATIENTNAME=$$GET1^DIQ(409.84,APPTIEN_",",.05,"E")
+8 DO REPORT(CONSULTIEN,APPTREQTYP,APPTDFN,PATIENTNAME,CONSULTPATDFN,APPTIEN,CONSULTPATIENT)
+9 QUIT
+10 ;
REPORT(REQIEN,APPTREQTYP,APPTPATDFN,PATIENTNAME,REQPATDFN,APPTIEN,REQPATIENT) ;
+1 SET CNT=CNT+1
+2 SET TEXTCNT=TEXTCNT+1
+3 SET ^XTMP("SDES842P",TEXTCNT)=" Request to be reviewed : "_REQIEN_" "_APPTREQTYP
+4 SET TEXTCNT=TEXTCNT+1
+5 SET ^XTMP("SDES842P",TEXTCNT)=" Appointment : "_APPTIEN
+6 SET TEXTCNT=TEXTCNT+1
+7 SET ^XTMP("SDES842P",TEXTCNT)=" Appointment Date/Time : "_$$GET1^DIQ(409.84,APPTIEN_",",.01,"E")
+8 SET TEXTCNT=TEXTCNT+1
+9 SET ^XTMP("SDES842P",TEXTCNT)=" Appointment Made Date : "_$$GET1^DIQ(409.84,APPTIEN_",",.09,"E")
+10 SET TEXTCNT=TEXTCNT+1
+11 SET ^XTMP("SDES842P",TEXTCNT)=" Patient on appointment : "_APPTDFN_" "_$$LAST4SSN^SDESINPUTVALUTL(APPTPATDFN)
+12 SET TEXTCNT=TEXTCNT+1
+13 SET ^XTMP("SDES842P",TEXTCNT)=" Patient on request : "_REQPATDFN_" "_$$LAST4SSN^SDESINPUTVALUTL(REQPATDFN)
+14 SET TEXTCNT=TEXTCNT+1
+15 SET ^XTMP("SDES842P",TEXTCNT)=""
+16 QUIT
+17 ;
