Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIULO1

TIULO1.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;^XLFSTR 10104, ^XLFDT 10103, ^PXRMD(810.9 5599, ^SC("AST" 4482, ^SDAPI^SDAMA301 4433, ^VADPT 10061
  1. ;^LAB(60,"B" 3853, LR7OR2 3856
  1. ;
  1. VISDATE(TIU) ; Visit date/time
  1. N TIUX,TIUY
  1. S TIUX=$S(+$G(TIU("VISIT")):$P($G(TIU("VISIT")),U,2),$L($G(TIU("VSTR"))):$P($G(TIU("VSTR")),";",2),1:"")
  1. I TIUX']"" S TIUY="VISIT DATE UNKNOWN" G VISDTX
  1. S TIUY=$$DATE^TIULS(TIUX,"MM/DD/YY HR:MIN")
  1. VISDTX Q $G(TIUY)
  1. LABS(DFN,TIUTEST,TIUEDT,TIULDT) ; Get Lab Results
  1. N TIUY,TIUTST,TIUX S TIUTST=+$O(^LAB(60,"B",TIUTEST,0))
  1. I '+$G(TIUTST) G LABX
  1. D TEST^LR7OR2(.TIUY,DFN,"",$G(TIUEDT),$G(TIULDT),"",TIUTST)
  1. S TIUX=$S($D(TIUY)#2:$G(@TIUY@(1)),1:"____")
  1. I $L(TIUX,U)>1 D
  1. . S TIUTST=$P(TIUX,U,4)_" "_$P(TIUX,U,6)_" "_$P(TIUX,U,5)_" ("
  1. . S TIUTST=TIUTST_$$DATE^TIULS($P(TIUX,U),"MM/DD/CCYY HR:MIN")_")"
  1. E S TIUTST=TIUX
  1. I $D(TIUY)#2 K @TIUY
  1. LABX Q $G(TIUTST)
  1. ;
  1. HPHONE(DFN) ;Current Home Telephone Number
  1. N VAPA
  1. D ADD^VADPT
  1. HPHX Q $G(VAPA(8))
  1. ;
  1. SADD(DFN) ;Single Line Street Address
  1. N VAPA,J
  1. D ADD^VADPT
  1. S:$D(VAPA(1)) J=VAPA(1) S:$D(VAPA(2)) J=J_" "_VAPA(2) S:$D(VAPA(3)) J=J_" "_VAPA(3)
  1. SADX Q J
  1. ;
  1. CISTZI(DFN) ;City, State, Zip
  1. N VAPA,J
  1. D ADD^VADPT
  1. 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)
  1. CSTX Q J
  1. ;
  1. MSTAPPT(DFN,TARGET) ;Missed MH appointments for past 10 days;; WAT-TIU*1.0*260
  1. K ^TMP($J,"TIU CLIN LIST"),@TARGET
  1. N CLINCNT S CLINCNT=1
  1. N RMLL,RMLLSTP,RMCLINIC,RMCLNCNT
  1. N TIUARR,SDCOUNT,SDDFN,SDDATE,SDAPPT,SDDATIME,SDCLINIC,APSTATUS,CLINAME
  1. N LINE,IDX1,ERROR,ENDT,DASH73
  1. S $P(DASH73,"=",73)="="
  1. S LINE=0,ERROR=0
  1. S @TARGET@(LINE,0)="",LINE=LINE+1
  1. S @TARGET@(LINE,0)="MH Appointments Missed Last 10 Days",LINE=LINE+1
  1. S @TARGET@(LINE,0)="",LINE=LINE+1
  1. S RMLL=$O(^PXRMD(810.9,"B","VA-MH NO SHOW APPT CLINICS LL",""))
  1. S RMCLNCNT=0,IDX1=0,RMCLINIC=""
  1. I $G(RMLL)="" S SDCOUNT=0 D ERROR Q "~@"_$NA(@TARGET) ;error and quit if RMLL not found
  1. F S IDX1=$O(^PXRMD(810.9,RMLL,40.7,IDX1)) Q:IDX1'>0!(ERROR=1) D
  1. .S RMLLSTP=^PXRMD(810.9,RMLL,40.7,IDX1,0)
  1. .S RMLLSTP=$P($G(RMLLSTP),"^") ;->this is the stop code, now get clinics for this stop code
  1. .Q:$D(^SC("AST",RMLLSTP))=0
  1. .F S RMCLINIC=$O(^SC("AST",RMLLSTP,RMCLINIC)) Q:RMCLINIC=""!(ERROR=1) D
  1. ..S ^TMP($J,"TIU CLIN LIST",RMCLINIC)=RMCLINIC
  1. ;NOW HAVE LIST OF CLINICS TO SEARCH FOR APPOINTMENTS
  1. ;CALL SDAPI ONCE FOR ALL CLINICS IN THE LIST
  1. S ENDT=$$FMADD^XLFDT(DT,-10)
  1. S TIUARR(1)=ENDT_";"_DT
  1. S TIUARR(2)="^TMP($J,""TIU CLIN LIST""" ;an array of clinic IENs
  1. S TIUARR(3)="NS;NSR" ;appt status NO SHOW & NO SHOW RESCHEDULED
  1. S TIUARR(4)=DFN
  1. S TIUARR("FLDS")="1;2;4;3"
  1. S TIUARR("SORT")="P"
  1. S SDCOUNT=$$SDAPI^SDAMA301(.TIUARR)
  1. I SDCOUNT=0 S @TARGET@(LINE,0)="No Missed Appointments Found",LINE=LINE+1
  1. I SDCOUNT<0 D ERROR Q "~@"_$NA(@TARGET)
  1. I SDCOUNT>0 D
  1. . S @TARGET@(LINE,0)="DATE/TIME"_$J("CLINIC",19)_$J("STATUS",32),LINE=LINE+1
  1. . S @TARGET@(LINE,0)=DASH73,LINE=LINE+1
  1. . S SDDFN=0 F S SDDFN=$O(^TMP($J,"SDAMA301",SDDFN)) Q:SDDFN="" D
  1. .. ;get appointment date/time
  1. .. S SDDATE=0 F S SDDATE=$O(^TMP($J,"SDAMA301",SDDFN,SDDATE)) Q:SDDATE="" D
  1. ... S SDAPPT=$G(^TMP($J,"SDAMA301",SDDFN,SDDATE)) ;appointment data
  1. ... S SDDATIME=$P($G(SDAPPT),"^",1) ;appointment date/time
  1. ... S APSTATUS=$P($G(SDAPPT),"^",3),APSTATUS=$P(APSTATUS,";",2)
  1. ... S CLINAME=$P($G(SDAPPT),"^",2),CLINAME=$P(CLINAME,";",2) ;CLINIC NAME
  1. ... I $L(CLINAME)<30 S CLINAME=CLINAME_($$REPEAT^XLFSTR(" ",(30-$L(CLINAME))))
  1. ... S SDDATIME=$$FMTE^XLFDT(SDDATIME,"5ZP")
  1. ... I $L(SDDATIME)<20 S SDDATIME=SDDATIME_($$REPEAT^XLFSTR(" ",(22-$L(SDDATIME)))) ;WAT/265
  1. ... I APSTATUS["&" S APSTATUS=$E(APSTATUS,1,17)_"."
  1. ... I $L(APSTATUS)<18 S APSTATUS=APSTATUS_($$REPEAT^XLFSTR(" ",(18-$L(APSTATUS))))
  1. ... S @TARGET@(LINE,0)=SDDATIME_CLINAME_$J(APSTATUS,20),LINE=LINE+1
  1. I SDCOUNT'=0 K ^TMP($J,"SDAMA301")
  1. Q "~@"_$NA(@TARGET)
  1. ;
  1. ERROR ;errors returned from SDAPI
  1. N IDXERR S IDXERR=""
  1. I $G(RMLL)="" S @TARGET@(LINE,0)="Reminder location list not found. Unable to retrun appointment data",LINE=LINE+1 Q
  1. F S IDXERR=$O(^TMP($J,"SDAMA301",IDXERR)) Q:IDXERR'>0 D
  1. .S @TARGET@(LINE,0)=^TMP($J,"SDAMA301",IDXERR),LINE=LINE+1
  1. Q