GMTSMHAP ; SLC/WAT - PRINT/EXTRACT FOR HRMH APPOINTMENT COMPONENT INFO ;Apr 26, 2018@13:31
;;2.7;Health Summary;**99,67**;Oct 20, 1995;Build 538
;
;EXTERNAL CALLS
;REMINDER LOCATION LIST ^PXRMD(810.9 5599
;^SC("AST" 4482
;$$SDAPI^SDAMA301 4433
;$$FMTE^XLFDT 10103
;
;
Q
;
EN ;MAIN
K ^TMP($J,"GMTS CLIN LIST"),^TMP($J,"GMTS APPT")
N CLINCNT S CLINCNT=1
N RMLL,RMLLSTP,RMCLINIC,RMCLNCNT
N GMTSARR,APCOUNT,PTDFN,APDATE,APPT,GMTSDTTM,CLINAME
N TAB,LINE,IDX1
S RMLL=$O(^PXRMD(810.9,"B","VA-MH NO SHOW APPT CLINICS LL",""))
S RMCLNCNT=0,IDX1=0,RMCLINIC=""
S TAB=" ",LINE=0
I $G(RMLL)="" D LLERR Q ;err and quit if RMLL not found
F S IDX1=$O(^PXRMD(810.9,RMLL,40.7,IDX1)) Q:IDX1'>0 D
.S RMLLSTP=^PXRMD(810.9,RMLL,40.7,IDX1,0)
.S RMLLSTP=$P($G(RMLLSTP),"^") ;->this is the stop code, now get clinics for this stop code
.Q:$D(^SC("AST",RMLLSTP))=0
.F S RMCLINIC=$O(^SC("AST",RMLLSTP,RMCLINIC)) Q:RMCLINIC="" D
..S ^TMP($J,"GMTS CLIN LIST",RMCLINIC)=RMCLINIC
I '$D(^TMP($J,"GMTS CLIN LIST")) D CLINERR Q ;err and quit if no clinics found
;CALL SDAPI ONCE FOR ALL CLINICS IN THE LIST
S GMTSARR(1)=DT ;date filter, can be FROM DATE;TO DATE; DT will get ALL from Today Forward
S GMTSARR(2)="^TMP($J,""GMTS CLIN LIST"""
S GMTSARR(3)="R" ;appt status R=scheduled/kept, I=inpatient
S GMTSARR(4)=DFN
S GMTSARR("FLDS")="1;2;4;3"
S GMTSARR("SORT")="P" ;implement sort to order appointments by appointment date
S APCOUNT=$$SDAPI^SDAMA301(.GMTSARR)
Q:APCOUNT<0 ;some other error from SD not already accounted for elsewhere
I APCOUNT>0 D
. S PTDFN=0 F S PTDFN=$O(^TMP($J,"SDAMA301",PTDFN)) Q:PTDFN="" D
.. S APDATE=0 F S APDATE=$O(^TMP($J,"SDAMA301",PTDFN,APDATE)) Q:APDATE="" D
... S APPT=$G(^TMP($J,"SDAMA301",PTDFN,APDATE)) ;appointment data
... S GMTSDTTM=$P($G(APPT),"^",1) ;appointment date/time
... S CLINAME=$P($G(APPT),"^",2),CLINAME=$P(CLINAME,";",2) ;CLINIC NAME
... S ^TMP($J,"GMTS APPT",LINE)=$$FMTE^XLFDT(GMTSDTTM,"5ZP")_TAB_$G(CLINAME),LINE=LINE+1
I APCOUNT'=0 K ^TMP($J,"SDAMA301")
D:$D(^TMP($J,"GMTS APPT",0))>0 PRINT
Q
;
PRINT ;print
N LINE S LINE=""
F S LINE=$O(^TMP($J,"GMTS APPT",LINE)) D Q:LINE=""
.Q:LINE=""
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W:LINE=0 ?2,^TMP($J,"GMTS APPT",LINE)
.W:LINE>0 !,?2,^TMP($J,"GMTS APPT",LINE)
W !
Q
;
LLERR ;LL not found
D CKP^GMTSUP Q:$D(GMTSQIT) W !,?2,"Reminder location list not found. Unable to return appointment data.",!
Q
CLINERR ;no clinics setup for LL
D CKP^GMTSUP Q:$D(GMTSQIT) W !,?2,"No matching clinics found. Unable to return appointment data.",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSMHAP 2636 printed Nov 22, 2024@17:08:18 Page 2
GMTSMHAP ; SLC/WAT - PRINT/EXTRACT FOR HRMH APPOINTMENT COMPONENT INFO ;Apr 26, 2018@13:31
+1 ;;2.7;Health Summary;**99,67**;Oct 20, 1995;Build 538
+2 ;
+3 ;EXTERNAL CALLS
+4 ;REMINDER LOCATION LIST ^PXRMD(810.9 5599
+5 ;^SC("AST" 4482
+6 ;$$SDAPI^SDAMA301 4433
+7 ;$$FMTE^XLFDT 10103
+8 ;
+9 ;
+10 QUIT
+11 ;
EN ;MAIN
+1 KILL ^TMP($JOB,"GMTS CLIN LIST"),^TMP($JOB,"GMTS APPT")
+2 NEW CLINCNT
SET CLINCNT=1
+3 NEW RMLL,RMLLSTP,RMCLINIC,RMCLNCNT
+4 NEW GMTSARR,APCOUNT,PTDFN,APDATE,APPT,GMTSDTTM,CLINAME
+5 NEW TAB,LINE,IDX1
+6 SET RMLL=$ORDER(^PXRMD(810.9,"B","VA-MH NO SHOW APPT CLINICS LL",""))
+7 SET RMCLNCNT=0
SET IDX1=0
SET RMCLINIC=""
+8 SET TAB=" "
SET LINE=0
+9 ;err and quit if RMLL not found
IF $GET(RMLL)=""
DO LLERR
QUIT
+10 FOR
SET IDX1=$ORDER(^PXRMD(810.9,RMLL,40.7,IDX1))
if IDX1'>0
QUIT
Begin DoDot:1
+11 SET RMLLSTP=^PXRMD(810.9,RMLL,40.7,IDX1,0)
+12 ;->this is the stop code, now get clinics for this stop code
SET RMLLSTP=$PIECE($GET(RMLLSTP),"^")
+13 if $DATA(^SC("AST",RMLLSTP))=0
QUIT
+14 FOR
SET RMCLINIC=$ORDER(^SC("AST",RMLLSTP,RMCLINIC))
if RMCLINIC=""
QUIT
Begin DoDot:2
+15 SET ^TMP($JOB,"GMTS CLIN LIST",RMCLINIC)=RMCLINIC
End DoDot:2
End DoDot:1
+16 ;err and quit if no clinics found
IF '$DATA(^TMP($JOB,"GMTS CLIN LIST"))
DO CLINERR
QUIT
+17 ;CALL SDAPI ONCE FOR ALL CLINICS IN THE LIST
+18 ;date filter, can be FROM DATE;TO DATE; DT will get ALL from Today Forward
SET GMTSARR(1)=DT
+19 SET GMTSARR(2)="^TMP($J,""GMTS CLIN LIST"""
+20 ;appt status R=scheduled/kept, I=inpatient
SET GMTSARR(3)="R"
+21 SET GMTSARR(4)=DFN
+22 SET GMTSARR("FLDS")="1;2;4;3"
+23 ;implement sort to order appointments by appointment date
SET GMTSARR("SORT")="P"
+24 SET APCOUNT=$$SDAPI^SDAMA301(.GMTSARR)
+25 ;some other error from SD not already accounted for elsewhere
if APCOUNT<0
QUIT
+26 IF APCOUNT>0
Begin DoDot:1
+27 SET PTDFN=0
FOR
SET PTDFN=$ORDER(^TMP($JOB,"SDAMA301",PTDFN))
if PTDFN=""
QUIT
Begin DoDot:2
+28 SET APDATE=0
FOR
SET APDATE=$ORDER(^TMP($JOB,"SDAMA301",PTDFN,APDATE))
if APDATE=""
QUIT
Begin DoDot:3
+29 ;appointment data
SET APPT=$GET(^TMP($JOB,"SDAMA301",PTDFN,APDATE))
+30 ;appointment date/time
SET GMTSDTTM=$PIECE($GET(APPT),"^",1)
+31 ;CLINIC NAME
SET CLINAME=$PIECE($GET(APPT),"^",2)
SET CLINAME=$PIECE(CLINAME,";",2)
+32 SET ^TMP($JOB,"GMTS APPT",LINE)=$$FMTE^XLFDT(GMTSDTTM,"5ZP")_TAB_$GET(CLINAME)
SET LINE=LINE+1
End DoDot:3
End DoDot:2
End DoDot:1
+33 IF APCOUNT'=0
KILL ^TMP($JOB,"SDAMA301")
+34 if $DATA(^TMP($JOB,"GMTS APPT",0))>0
DO PRINT
+35 QUIT
+36 ;
PRINT ;print
+1 NEW LINE
SET LINE=""
+2 FOR
SET LINE=$ORDER(^TMP($JOB,"GMTS APPT",LINE))
Begin DoDot:1
+3 if LINE=""
QUIT
+4 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+5 if LINE=0
WRITE ?2,^TMP($JOB,"GMTS APPT",LINE)
+6 if LINE>0
WRITE !,?2,^TMP($JOB,"GMTS APPT",LINE)
End DoDot:1
if LINE=""
QUIT
+7 WRITE !
+8 QUIT
+9 ;
LLERR ;LL not found
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE !,?2,"Reminder location list not found. Unable to return appointment data.",!
+2 QUIT
CLINERR ;no clinics setup for LL
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE !,?2,"No matching clinics found. Unable to return appointment data.",!
+2 QUIT
