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

SDAM1.m

Go to the documentation of this file. 
  1. SDAM1 ;MJK/ALB - Appt Mgt (Patient);Apr 23 1999
  1.  ;;5.3;PIMS;**149,155,193,189,445,478,466,1003,1004,1005,1014,1015,1016**;JUN 30, 2012;Build 20
  1.  ;
  1.  ;IHS/ANMC/LJF  4/11/2002 removed check for VA parameter
  1.  ;IHS/ITSC/LJF 06/17/2005 PATCH 1003 allow appt threshold to be set to zero
  1.  ;IHS/OIT/LJF  07/28/2005 PATCH 1004 added call to display waiting list info
  1.  ;IHS/OIT/LJF  12/29/2005 PATCH 1005 added "Walk In" to status display
  1.  ;                                   removed code for status to blink if checked in by ancillary service
  1.  ;ihs/cmi/maw 02/02/2012 patch 1014, changed set of appointment mode to silent fileman call
  1.  ;
  1. INIT ; -- get init pat appt data
  1.  ;  input:          DFN := ifn of pat
  1.  ; output:  ^TMP("SDAM" := appt array
  1.  ;IHS/ITSC/LJF 6/17/2005 PATCH 1003
  1.  ;S X=$P($G(^DG(43,1,"SCLR")),U,12),SDPRD=$S(X:X,1:2)
  1.  S X=$P($G(^DG(43,1,"SCLR")),U,12),SDPRD=$S(X]"":X,1:2)
  1.  S X1=DT,X2=-SDPRD D C^%DTC S SDBEG=X
  1.  S X1=DT,X2=999 D C^%DTC S SDEND=X
  1.  D CHGCAP^VALM("NAME","Clinic")
  1.  S X="ALL" D LIST^SDAM
  1.  Q
  1.  ;
  1. BLD ; -- scan apts
  1.  N SDAMDD,SDNAME,SDMAX,SDLARGE,DFN,SDCL,BL,XC,XW,AC,AW,TC,TW,NC,NW,SC,SW,SDT,CC,CW,CN,CNPAT,CNSTLNK,CSTAT ; done for speed see INIT
  1.  D INIT^SDAM10
  1.  S DFN=SDFN
  1.  F SDT=SDBEG:0 S SDT=$O(^DPT(DFN,"S",SDT)) Q:'SDT!($P(SDT,".",1)>SDEND)  I $D(^(SDT,0)) S SDATA=^(0),SDCL=+SDATA,SDNAME=$P($G(^SC(SDCL,0)),U) D  K:CNSTLNK="" CNSTLNK D BLD1  ;SD/478
  1.  .S CNSTLNK="",CN=0 F  S CN=$O(^SC(SDCL,"S",SDT,1,CN)) Q:'+CN  S CNPAT=$P($G(^SC(SDCL,"S",SDT,1,CN,0)),U) I CNPAT=DFN S CNSTLNK=$P($G(^SC(SDCL,"S",SDT,1,CN,"CONS")),U),CSTAT="" S:CNSTLNK'="" CSTAT=$P($G(^GMR(123,CNSTLNK,0)),U,12) Q  ;SD/478
  1.  ;
  1.  I $O(^TMP("SDAM",$J,0)) D WLDIS^BSDAM(DFN)  ;IHS/OIT/LJF 7/28/2005 PATCH 1004
  1.  ;
  1.  D NUL^SDAM10,LARGE^SDAM10:$D(SDLARGE)
  1.  S $P(^TMP("SDAM",$J,0),U,4)=VALMCNT
  1.  Q
  1.  ;
  1. BLD1 ; -- build array
  1.  N SDX,X,Y,Y1,SDSTAT,SDELIG
  1.  S SDSTAT=$$STATUS(DFN,SDT,SDCL,SDATA,$S($D(SDDA):SDDA,1:""))
  1.  G BLD1Q:'$$CHK(DFN,SDT,SDCL,SDATA,.SDAMLIST,SDSTAT)
  1.  ;; Changes for GAF enhancement
  1.  S SDGAFREQ=" "
  1.  S SDELIG=$$ELSTAT^SDUTL2(DFN)
  1.  I $$MHCLIN^SDUTL2(SDCL),'($$COLLAT^SDUTL2(SDELIG)!$P(SDATA,U,11)) D
  1.  .S SDGAF=$$NEWGAF^SDUTL2(DFN),SDGAFST=$P(SDGAF,"^")
  1.  .S:SDGAFST SDGAFREQ="*"
  1.  S SDACNT=SDACNT+1,X="",$P(X," ",VALMWD+1)=""
  1.  W:(SDACNT#10)=0 "."
  1.  I SDACNT=SDMAX,$P(SDT,".")'=SDEND S SDEND=$P(SDT,"."),SDLARGE=""
  1.  S X=SDGAFREQ_$E(X,2,AC-1)_$E(SDACNT_BL,1,AW)_$E(X,AC+AW+1,VALMWD)
  1.  S X=$E(X,1,NC-1)_$E($$LOWER(SDNAME)_BL,1,NW)_$E(X,NC+NW+1,VALMWD)
  1.  S X=$E(X,1,XC-1)_$E($$FMTE^XLFDT(SDT,"5Z")_BL,1,XW)_$E(X,XC+XW+1,VALMWD)  ;to make date field work for SD*5.3*189 - uses FM List Template
  1.  S:'$D(CSTAT) CSTAT="" ;SD/478
  1.  S X=$E(X,1,CC-1)_$E($S((CSTAT=1!(CSTAT=2)!(CSTAT=13)):" ",$G(CNSTLNK):"Consult",1:"        ")_BL,1,CW)_$E(X,CC+CW+1,VALMWD) K CNSTLNK,CSTAT ;SD/478
  1.  S Y=$P(SDSTAT,";",3)
  1.  ;
  1.  I (Y["CHECKED"),$P(SDATA,U,7)=4,('$P(SDSTAT,";",6)) S Y="WALK IN/"_Y   ;IHS/OIT/LJF 12/29/2005 PATCH 1005
  1.  ;
  1.  I Y'["FUTURE" S X=$E(X,1,SC-1)_$E($$LOWER(Y)_BL,1,SW)_$E(X,SC+SW+1,VALMWD)
  1.  I Y["FUTURE" S X=$E(X,1,SC-1)_$E($$LOWER(Y)_$$ANC_BL,1,SW+TW+1)
  1.  S Y1=$S($P(SDSTAT,";",5):$P(SDSTAT,";",5),1:$P(SDSTAT,";",4)),Y1=$S($P(Y1,".")=DT:$$TIME($P(Y1,".",2)),1:"")
  1.  S:Y1]"" X=$E(X,1,TC-1)_$E(Y1_BL,1,TW)_$E(X,TC+TW+1,VALMWD)
  1.  D SET(X)
  1.  I $D(SDAMBOLD(DFN,SDT,SDCL)) D FLDCTRL^VALM10(VALMCNT,"STAT",IOINHI,IOINORM),FLDCTRL^VALM10(VALMCNT,"TIME",IOINHI,IOINORM)
  1.  S ^TMP("SDAMIDX",$J,SDACNT)=VALMCNT_U_DFN_U_SDT_U_SDCL_U_$S($D(SDDA):SDDA,1:"")
  1. BLD1Q Q
  1.  ;
  1. ANC() ; -- set ancillary info
  1.  N I,Y,C
  1.  S Y="",C=0
  1.  F I=3:1:5 I $P(SDATA,U,I)]"" S Y=Y_" "_$P("^^Lab^XRay^EKG",U,I)_"@"_$$TIME($P($P(SDATA,U,I),".",2)),C=C+1 Q:C=2
  1.  I Y]"" S Y="/"_$E(Y,2,99)
  1.  Q Y
  1.  ;  
  1. SET(X) ;
  1.  S VALMCNT=VALMCNT+1,^TMP("SDAM",$J,VALMCNT,0)=X
  1.  S:SDACNT ^TMP("SDAM",$J,"IDX",VALMCNT,SDACNT)=""
  1.  Q
  1.  ;
  1. CHK(DFN,SDT,SDCL,SDATA,SDAMLIST,SDSTAT,SDDA) ; -- does appt meet criteria
  1.  ;   input:        DFN := ifn of pat.
  1.  ;                 SDT := appt d/t
  1.  ;                SDCL := ifn of clinic
  1.  ;               SDATA := 0th node of pat appt entry
  1.  ;            SDAMLIST := list definition
  1.  ;              SDSTAT := appt status data from $$STATUS call
  1.  ;                SDDA := ifn for ^SC(clinic,"S",date,1,ifn) {optional}
  1.  ;  output: [returned] := meets criteria for list [0 - no | 1 - yes ]
  1.  ;
  1.  S Y=0
  1.  I $D(SDAMLIST(+SDSTAT)) S Y=1 G CHKQ
  1.  I $P(SDAMLIST,U)="ALL" S Y=1
  1.  I $P(SDAMLIST,U)="CHECKED IN" I $P(SDSTAT,";",3)="ACT REQ/CHECKED IN" S Y=1  ; - SD*5.3*445
  1. CHKQ I Y,$D(SDAMLIST("SCR")) X SDAMLIST("SCR") S Y=$T
  1.  Q Y
  1.  ;
  1. STATUS(DFN,SDT,SDCL,SDATA,SDDA) ; -- return appt status
  1.  ;   input:        DFN := ifn of pat.
  1.  ;                 SDT := appt d/t
  1.  ;                SDCL := ifn of clinic
  1.  ;               SDATA := 0th node of pat appt entry
  1.  ;                SDDA := ifn for ^SC(clinic,"S",date,1,ifn) {optional}
  1.  ;  output: [returned] := appt status ifn ^ status name ^ print status ^
  1.  ;                        check in d/t ^ check out d/t ^ adm mvt ifn
  1.  ;
  1.  ;S = status ; C = ci/co indicator ; Y = 'C' node ; P = print status
  1.  N S,C,Y,P,VADMVT,VAINDT
  1.  ;
  1.  ; -- get data for evaluation
  1.  S:'$G(SDDA) SDDA=+$$FIND^SDAM2(DFN,SDT,SDCL)
  1.  S Y=$G(^SC(SDCL,"S",SDT,1,SDDA,"C"))
  1.  ;
  1.  ; -- set initial status value ; non-count clinic?
  1.  S S=$S($P(SDATA,"^",2)]"":$P($P($P(^DD(2.98,3,0),"^",3),$P(SDATA,"^",2)_":",2),";"),$P($G(^SC(SDCL,0)),U,17)="Y":"NON-COUNT",1:"")
  1.  ;
  1.  ; -- inpatient?
  1.  S VAINDT=SDT D ADM^VADPT2
  1.  I S["INPATIENT",$S('VADMVT:1,'$P(^DG(43,1,0),U,21):0,1:$P($G(^DIC(42,+$P($G(^DGPM(VADMVT,0)),U,6),0)),U,3)="D") S S=""
  1.  ;
  1.  ; -- determine ci/co indicator
  1.  I Y="",SDT<DT,$D(^SCE("ADFN",DFN,SDT)) S POP=0 D CHKENC G:POP STAT1  ;SD*567
  1.  K POP
  1.  S C=$S($P(Y,"^",3):"CHECKED OUT",Y:"CHECKED IN",S]"":"",SDT>(DT+.2359):"FUTURE",1:"NO ACTION TAKEN") S:S="" S=C
  1.  I S="NO ACTION TAKEN",$P(SDT,".")=DT,C'["CHECKED" S C="TODAY"
  1. STAT1 ; -- $$REQ & $$COCMP in SDM1A not used for speed
  1.  K POP
  1.  ;I S="CHECKED OUT"!(S="CHECKED IN"),SDT'<$P(^DG(43,1,"SCLR"),U,23),'$P($G(^SCE(+$P(SDATA,U,20),0)),U,7) S S="NO ACTION TAKEN"  ;IHS/ANMC/LJF 4/11/2002
  1.  ;
  1.  ; -- determine print status
  1.  S P=$S(S=C!(C=""):S,1:"")
  1.  I P="" D
  1.  .I S["INPATIENT",$P($G(^SC(SDCL,0)),U,17)'="Y",$P($G(^SCE(+$P(SDATA,U,20),0)),U,7)="" S P=$P(S," ")_"/ACT REQ" Q
  1.  .I S="NO ACTION TAKEN",C="CHECKED OUT"!(C="CHECKED IN") S P="ACT REQ/"_C Q
  1.  .;next line for testing
  1.  .;I S="CANCELLED BY CLINIC" I $P(Y,U,1)'="" I $P(Y,U,3)="" S P=S Q
  1.  .S P=$S(S="NO ACTION TAKEN":S,1:$P(S," "))_"/"_C
  1.  I S["INPATIENT",C="" D
  1.  .I SDT>(DT+.2359) S P=$P(S," ")_"/FUTURE" Q
  1.  .S P=$P(S," ")_"/NO ACT TAKN"
  1.  ;
  1. STATUSQ Q +$O(^SD(409.63,"AC",S,0))_";"_S_";"_P_";"_$P(Y,"^")_";"_$P(Y,"^",3)_";"_+VADMVT
  1.  ;
  1. CHKENC ;SD*567 grab status from outpatient encounter for purged appts
  1.  N SNODE,SDIEN
  1.  S SDIEN=""
  1.  S SDIEN=$O(^SCE("ADFN",DFN,SDT,SDIEN)) Q:'SDIEN
  1.  S SNODE=$G(^SCE(SDIEN,0))
  1.  Q:SNODE=""
  1.  Q:'$D(^SD(409.63,$P(SNODE,U,12),0))
  1.  S C=$P(^SD(409.63,$P(SNODE,U,12),0),U,1),POP=1
  1.  S:S="" S=C
  1.  Q
  1.  ;
  1. LOWER(X) ; convert to lowercase ; same as LOWER^VALM1 ; here for speed
  1.  N Y,C,I
  1.  S Y=$E(X)_$TR($E(X,2,999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ@","abcdefghijklmnopqrstuvwxyz ")
  1.  F C=" ",",","/" S I=0 F  S I=$F(Y,C,I) Q:'I  S Y=$E(Y,1,I-1)_$TR($E(Y,I),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(Y,I+1,999)
  1.  Q Y
  1.  ;
  1. TIME(X) ; -- format time only :=   hr:min
  1.  Q $E(X_"0000",1,2)_":"_$E(X_"0000",3,4)