- TIULO1 ; SLC/JER - More embedded Objects ;05/31/12 14:33
- ;;1.0;TEXT INTEGRATION UTILITIES;**47,260,265**;Jun 20, 1997;Build 25
- ;
- ;^XLFSTR 10104, ^XLFDT 10103, ^PXRMD(810.9 5599, ^SC("AST" 4482, ^SDAPI^SDAMA301 4433, ^VADPT 10061
- ;^LAB(60,"B" 3853, LR7OR2 3856
- ;
- VISDATE(TIU) ; Visit date/time
- N TIUX,TIUY
- S TIUX=$S(+$G(TIU("VISIT")):$P($G(TIU("VISIT")),U,2),$L($G(TIU("VSTR"))):$P($G(TIU("VSTR")),";",2),1:"")
- I TIUX']"" S TIUY="VISIT DATE UNKNOWN" G VISDTX
- S TIUY=$$DATE^TIULS(TIUX,"MM/DD/YY HR:MIN")
- VISDTX Q $G(TIUY)
- LABS(DFN,TIUTEST,TIUEDT,TIULDT) ; Get Lab Results
- N TIUY,TIUTST,TIUX S TIUTST=+$O(^LAB(60,"B",TIUTEST,0))
- I '+$G(TIUTST) G LABX
- D TEST^LR7OR2(.TIUY,DFN,"",$G(TIUEDT),$G(TIULDT),"",TIUTST)
- S TIUX=$S($D(TIUY)#2:$G(@TIUY@(1)),1:"____")
- I $L(TIUX,U)>1 D
- . S TIUTST=$P(TIUX,U,4)_" "_$P(TIUX,U,6)_" "_$P(TIUX,U,5)_" ("
- . S TIUTST=TIUTST_$$DATE^TIULS($P(TIUX,U),"MM/DD/CCYY HR:MIN")_")"
- E S TIUTST=TIUX
- I $D(TIUY)#2 K @TIUY
- LABX Q $G(TIUTST)
- ;
- HPHONE(DFN) ;Current Home Telephone Number
- N VAPA
- D ADD^VADPT
- HPHX Q $G(VAPA(8))
- ;
- SADD(DFN) ;Single Line Street Address
- N VAPA,J
- D ADD^VADPT
- S:$D(VAPA(1)) J=VAPA(1) S:$D(VAPA(2)) J=J_" "_VAPA(2) S:$D(VAPA(3)) J=J_" "_VAPA(3)
- SADX Q J
- ;
- CISTZI(DFN) ;City, State, Zip
- N VAPA,J
- D ADD^VADPT
- S:$D(VAPA(4)) J=VAPA(4) S:$D(VAPA(5)) J=J_", "_$P(VAPA(5),U,2) S:$D(VAPA(6)) J=J_", "_VAPA(6)
- CSTX Q J
- ;
- MSTAPPT(DFN,TARGET) ;Missed MH appointments for past 10 days;; WAT-TIU*1.0*260
- K ^TMP($J,"TIU CLIN LIST"),@TARGET
- N CLINCNT S CLINCNT=1
- N RMLL,RMLLSTP,RMCLINIC,RMCLNCNT
- N TIUARR,SDCOUNT,SDDFN,SDDATE,SDAPPT,SDDATIME,SDCLINIC,APSTATUS,CLINAME
- N LINE,IDX1,ERROR,ENDT,DASH73
- S $P(DASH73,"=",73)="="
- S LINE=0,ERROR=0
- S @TARGET@(LINE,0)="",LINE=LINE+1
- S @TARGET@(LINE,0)="MH Appointments Missed Last 10 Days",LINE=LINE+1
- S @TARGET@(LINE,0)="",LINE=LINE+1
- S RMLL=$O(^PXRMD(810.9,"B","VA-MH NO SHOW APPT CLINICS LL",""))
- S RMCLNCNT=0,IDX1=0,RMCLINIC=""
- I $G(RMLL)="" S SDCOUNT=0 D ERROR Q "~@"_$NA(@TARGET) ;error and quit if RMLL not found
- F S IDX1=$O(^PXRMD(810.9,RMLL,40.7,IDX1)) Q:IDX1'>0!(ERROR=1) 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=""!(ERROR=1) D
- ..S ^TMP($J,"TIU CLIN LIST",RMCLINIC)=RMCLINIC
- ;NOW HAVE LIST OF CLINICS TO SEARCH FOR APPOINTMENTS
- ;CALL SDAPI ONCE FOR ALL CLINICS IN THE LIST
- S ENDT=$$FMADD^XLFDT(DT,-10)
- S TIUARR(1)=ENDT_";"_DT
- S TIUARR(2)="^TMP($J,""TIU CLIN LIST""" ;an array of clinic IENs
- S TIUARR(3)="NS;NSR" ;appt status NO SHOW & NO SHOW RESCHEDULED
- S TIUARR(4)=DFN
- S TIUARR("FLDS")="1;2;4;3"
- S TIUARR("SORT")="P"
- S SDCOUNT=$$SDAPI^SDAMA301(.TIUARR)
- I SDCOUNT=0 S @TARGET@(LINE,0)="No Missed Appointments Found",LINE=LINE+1
- I SDCOUNT<0 D ERROR Q "~@"_$NA(@TARGET)
- I SDCOUNT>0 D
- . S @TARGET@(LINE,0)="DATE/TIME"_$J("CLINIC",19)_$J("STATUS",32),LINE=LINE+1
- . S @TARGET@(LINE,0)=DASH73,LINE=LINE+1
- . S SDDFN=0 F S SDDFN=$O(^TMP($J,"SDAMA301",SDDFN)) Q:SDDFN="" D
- .. ;get appointment date/time
- .. S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",SDDFN,SDDATE)) Q:SDDATE="" D
- ... S SDAPPT=$G(^TMP($J,"SDAMA301",SDDFN,SDDATE)) ;appointment data
- ... S SDDATIME=$P($G(SDAPPT),"^",1) ;appointment date/time
- ... S APSTATUS=$P($G(SDAPPT),"^",3),APSTATUS=$P(APSTATUS,";",2)
- ... S CLINAME=$P($G(SDAPPT),"^",2),CLINAME=$P(CLINAME,";",2) ;CLINIC NAME
- ... I $L(CLINAME)<30 S CLINAME=CLINAME_($$REPEAT^XLFSTR(" ",(30-$L(CLINAME))))
- ... S SDDATIME=$$FMTE^XLFDT(SDDATIME,"5ZP")
- ... I $L(SDDATIME)<20 S SDDATIME=SDDATIME_($$REPEAT^XLFSTR(" ",(22-$L(SDDATIME)))) ;WAT/265
- ... I APSTATUS["&" S APSTATUS=$E(APSTATUS,1,17)_"."
- ... I $L(APSTATUS)<18 S APSTATUS=APSTATUS_($$REPEAT^XLFSTR(" ",(18-$L(APSTATUS))))
- ... S @TARGET@(LINE,0)=SDDATIME_CLINAME_$J(APSTATUS,20),LINE=LINE+1
- I SDCOUNT'=0 K ^TMP($J,"SDAMA301")
- Q "~@"_$NA(@TARGET)
- ;
- ERROR ;errors returned from SDAPI
- N IDXERR S IDXERR=""
- I $G(RMLL)="" S @TARGET@(LINE,0)="Reminder location list not found. Unable to retrun appointment data",LINE=LINE+1 Q
- F S IDXERR=$O(^TMP($J,"SDAMA301",IDXERR)) Q:IDXERR'>0 D
- .S @TARGET@(LINE,0)=^TMP($J,"SDAMA301",IDXERR),LINE=LINE+1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIULO1 4354 printed Feb 19, 2025@00:08:48 Page 2
- TIULO1 ; SLC/JER - More embedded Objects ;05/31/12 14:33
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**47,260,265**;Jun 20, 1997;Build 25
- +2 ;
- +3 ;^XLFSTR 10104, ^XLFDT 10103, ^PXRMD(810.9 5599, ^SC("AST" 4482, ^SDAPI^SDAMA301 4433, ^VADPT 10061
- +4 ;^LAB(60,"B" 3853, LR7OR2 3856
- +5 ;
- VISDATE(TIU) ; Visit date/time
- +1 NEW TIUX,TIUY
- +2 SET TIUX=$SELECT(+$GET(TIU("VISIT")):$PIECE($GET(TIU("VISIT")),U,2),$LENGTH($GET(TIU("VSTR"))):$PIECE($GET(TIU("VSTR")),";",2),1:"")
- +3 IF TIUX']""
- SET TIUY="VISIT DATE UNKNOWN"
- GOTO VISDTX
- +4 SET TIUY=$$DATE^TIULS(TIUX,"MM/DD/YY HR:MIN")
- VISDTX QUIT $GET(TIUY)
- LABS(DFN,TIUTEST,TIUEDT,TIULDT) ; Get Lab Results
- +1 NEW TIUY,TIUTST,TIUX
- SET TIUTST=+$ORDER(^LAB(60,"B",TIUTEST,0))
- +2 IF '+$GET(TIUTST)
- GOTO LABX
- +3 DO TEST^LR7OR2(.TIUY,DFN,"",$GET(TIUEDT),$GET(TIULDT),"",TIUTST)
- +4 SET TIUX=$SELECT($DATA(TIUY)#2:$GET(@TIUY@(1)),1:"____")
- +5 IF $LENGTH(TIUX,U)>1
- Begin DoDot:1
- +6 SET TIUTST=$PIECE(TIUX,U,4)_" "_$PIECE(TIUX,U,6)_" "_$PIECE(TIUX,U,5)_" ("
- +7 SET TIUTST=TIUTST_$$DATE^TIULS($PIECE(TIUX,U),"MM/DD/CCYY HR:MIN")_")"
- End DoDot:1
- +8 IF '$TEST
- SET TIUTST=TIUX
- +9 IF $DATA(TIUY)#2
- KILL @TIUY
- LABX QUIT $GET(TIUTST)
- +1 ;
- HPHONE(DFN) ;Current Home Telephone Number
- +1 NEW VAPA
- +2 DO ADD^VADPT
- HPHX QUIT $GET(VAPA(8))
- +1 ;
- SADD(DFN) ;Single Line Street Address
- +1 NEW VAPA,J
- +2 DO ADD^VADPT
- +3 if $DATA(VAPA(1))
- SET J=VAPA(1)
- if $DATA(VAPA(2))
- SET J=J_" "_VAPA(2)
- if $DATA(VAPA(3))
- SET J=J_" "_VAPA(3)
- SADX QUIT J
- +1 ;
- CISTZI(DFN) ;City, State, Zip
- +1 NEW VAPA,J
- +2 DO ADD^VADPT
- +3 if $DATA(VAPA(4))
- SET J=VAPA(4)
- if $DATA(VAPA(5))
- SET J=J_", "_$PIECE(VAPA(5),U,2)
- if $DATA(VAPA(6))
- SET J=J_", "_VAPA(6)
- CSTX QUIT J
- +1 ;
- MSTAPPT(DFN,TARGET) ;Missed MH appointments for past 10 days;; WAT-TIU*1.0*260
- +1 KILL ^TMP($JOB,"TIU CLIN LIST"),@TARGET
- +2 NEW CLINCNT
- SET CLINCNT=1
- +3 NEW RMLL,RMLLSTP,RMCLINIC,RMCLNCNT
- +4 NEW TIUARR,SDCOUNT,SDDFN,SDDATE,SDAPPT,SDDATIME,SDCLINIC,APSTATUS,CLINAME
- +5 NEW LINE,IDX1,ERROR,ENDT,DASH73
- +6 SET $PIECE(DASH73,"=",73)="="
- +7 SET LINE=0
- SET ERROR=0
- +8 SET @TARGET@(LINE,0)=""
- SET LINE=LINE+1
- +9 SET @TARGET@(LINE,0)="MH Appointments Missed Last 10 Days"
- SET LINE=LINE+1
- +10 SET @TARGET@(LINE,0)=""
- SET LINE=LINE+1
- +11 SET RMLL=$ORDER(^PXRMD(810.9,"B","VA-MH NO SHOW APPT CLINICS LL",""))
- +12 SET RMCLNCNT=0
- SET IDX1=0
- SET RMCLINIC=""
- +13 ;error and quit if RMLL not found
- IF $GET(RMLL)=""
- SET SDCOUNT=0
- DO ERROR
- QUIT "~@"_$NAME(@TARGET)
- +14 FOR
- SET IDX1=$ORDER(^PXRMD(810.9,RMLL,40.7,IDX1))
- if IDX1'>0!(ERROR=1)
- QUIT
- Begin DoDot:1
- +15 SET RMLLSTP=^PXRMD(810.9,RMLL,40.7,IDX1,0)
- +16 ;->this is the stop code, now get clinics for this stop code
- SET RMLLSTP=$PIECE($GET(RMLLSTP),"^")
- +17 if $DATA(^SC("AST",RMLLSTP))=0
- QUIT
- +18 FOR
- SET RMCLINIC=$ORDER(^SC("AST",RMLLSTP,RMCLINIC))
- if RMCLINIC=""!(ERROR=1)
- QUIT
- Begin DoDot:2
- +19 SET ^TMP($JOB,"TIU CLIN LIST",RMCLINIC)=RMCLINIC
- End DoDot:2
- End DoDot:1
- +20 ;NOW HAVE LIST OF CLINICS TO SEARCH FOR APPOINTMENTS
- +21 ;CALL SDAPI ONCE FOR ALL CLINICS IN THE LIST
- +22 SET ENDT=$$FMADD^XLFDT(DT,-10)
- +23 SET TIUARR(1)=ENDT_";"_DT
- +24 ;an array of clinic IENs
- SET TIUARR(2)="^TMP($J,""TIU CLIN LIST"""
- +25 ;appt status NO SHOW & NO SHOW RESCHEDULED
- SET TIUARR(3)="NS;NSR"
- +26 SET TIUARR(4)=DFN
- +27 SET TIUARR("FLDS")="1;2;4;3"
- +28 SET TIUARR("SORT")="P"
- +29 SET SDCOUNT=$$SDAPI^SDAMA301(.TIUARR)
- +30 IF SDCOUNT=0
- SET @TARGET@(LINE,0)="No Missed Appointments Found"
- SET LINE=LINE+1
- +31 IF SDCOUNT<0
- DO ERROR
- QUIT "~@"_$NAME(@TARGET)
- +32 IF SDCOUNT>0
- Begin DoDot:1
- +33 SET @TARGET@(LINE,0)="DATE/TIME"_$JUSTIFY("CLINIC",19)_$JUSTIFY("STATUS",32)
- SET LINE=LINE+1
- +34 SET @TARGET@(LINE,0)=DASH73
- SET LINE=LINE+1
- +35 SET SDDFN=0
- FOR
- SET SDDFN=$ORDER(^TMP($JOB,"SDAMA301",SDDFN))
- if SDDFN=""
- QUIT
- Begin DoDot:2
- +36 ;get appointment date/time
- +37 SET SDDATE=0
- FOR
- SET SDDATE=$ORDER(^TMP($JOB,"SDAMA301",SDDFN,SDDATE))
- if SDDATE=""
- QUIT
- Begin DoDot:3
- +38 ;appointment data
- SET SDAPPT=$GET(^TMP($JOB,"SDAMA301",SDDFN,SDDATE))
- +39 ;appointment date/time
- SET SDDATIME=$PIECE($GET(SDAPPT),"^",1)
- +40 SET APSTATUS=$PIECE($GET(SDAPPT),"^",3)
- SET APSTATUS=$PIECE(APSTATUS,";",2)
- +41 ;CLINIC NAME
- SET CLINAME=$PIECE($GET(SDAPPT),"^",2)
- SET CLINAME=$PIECE(CLINAME,";",2)
- +42 IF $LENGTH(CLINAME)<30
- SET CLINAME=CLINAME_($$REPEAT^XLFSTR(" ",(30-$LENGTH(CLINAME))))
- +43 SET SDDATIME=$$FMTE^XLFDT(SDDATIME,"5ZP")
- +44 ;WAT/265
- IF $LENGTH(SDDATIME)<20
- SET SDDATIME=SDDATIME_($$REPEAT^XLFSTR(" ",(22-$LENGTH(SDDATIME))))
- +45 IF APSTATUS["&"
- SET APSTATUS=$EXTRACT(APSTATUS,1,17)_"."
- +46 IF $LENGTH(APSTATUS)<18
- SET APSTATUS=APSTATUS_($$REPEAT^XLFSTR(" ",(18-$LENGTH(APSTATUS))))
- +47 SET @TARGET@(LINE,0)=SDDATIME_CLINAME_$JUSTIFY(APSTATUS,20)
- SET LINE=LINE+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +48 IF SDCOUNT'=0
- KILL ^TMP($JOB,"SDAMA301")
- +49 QUIT "~@"_$NAME(@TARGET)
- +50 ;
- ERROR ;errors returned from SDAPI
- +1 NEW IDXERR
- SET IDXERR=""
- +2 IF $GET(RMLL)=""
- SET @TARGET@(LINE,0)="Reminder location list not found. Unable to retrun appointment data"
- SET LINE=LINE+1
- QUIT
- +3 FOR
- SET IDXERR=$ORDER(^TMP($JOB,"SDAMA301",IDXERR))
- if IDXERR'>0
- QUIT
- Begin DoDot:1
- +4 SET @TARGET@(LINE,0)=^TMP($JOB,"SDAMA301",IDXERR)
- SET LINE=LINE+1
- End DoDot:1
- +5 QUIT