- SDAM1 ;MJK/ALB - Appt Mgt (Patient);Apr 23 1999
- ;;5.3;Scheduling;**149,155,193,189,445,478,466,567,591,595**;Aug 13, 1993;Build 13
- ;
- INIT ; -- get init pat appt data
- ; input: DFN := ifn of pat
- ; output: ^TMP("SDAM" := appt array
- S X=$P($G(^DG(43,1,"SCLR")),U,12),SDPRD=$S(X:X,1:2)
- S X1=DT,X2=-SDPRD D C^%DTC S SDBEG=X
- S X1=DT,X2=999 D C^%DTC S SDEND=X
- D CHGCAP^VALM("NAME","Clinic")
- S X="ALL" D LIST^SDAM
- Q
- ;
- BLD ; -- scan apts
- 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
- D INIT^SDAM10
- S DFN=SDFN
- 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
- .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
- D NUL^SDAM10,LARGE^SDAM10:$D(SDLARGE)
- S $P(^TMP("SDAM",$J,0),U,4)=VALMCNT
- Q
- ;
- BLD1 ; -- build array
- N SDX,X,Y,Y1,SDSTAT,SDELIG
- S SDSTAT=$$STATUS(DFN,SDT,SDCL,SDATA,$S($D(SDDA):SDDA,1:""))
- G BLD1Q:'$$CHK(DFN,SDT,SDCL,SDATA,.SDAMLIST,SDSTAT)
- ;; Changes for GAF enhancement
- S SDGAFREQ=" "
- S SDELIG=$$ELSTAT^SDUTL2(DFN)
- I $$MHCLIN^SDUTL2(SDCL),'($$COLLAT^SDUTL2(SDELIG)!$P(SDATA,U,11)) D
- .S SDGAF=$$NEWGAF^SDUTL2(DFN),SDGAFST=$P(SDGAF,"^")
- .S:SDGAFST SDGAFREQ="*"
- S SDACNT=SDACNT+1,X="",$P(X," ",VALMWD+1)=""
- W:(SDACNT#10)=0 "."
- I SDACNT=SDMAX,$P(SDT,".")'=SDEND S SDEND=$P(SDT,"."),SDLARGE=""
- S X=SDGAFREQ_$E(X,2,AC-1)_$E(SDACNT_BL,1,AW)_$E(X,AC+AW+1,VALMWD)
- S X=$E(X,1,NC-1)_$E($$LOWER(SDNAME)_BL,1,NW)_$E(X,NC+NW+1,VALMWD)
- 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
- S:'$D(CSTAT) CSTAT="" ;SD/478
- 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
- S Y=$P(SDSTAT,";",3)
- I Y'["FUTURE" S X=$E(X,1,SC-1)_$E($$LOWER(Y)_BL,1,SW)_$E(X,SC+SW+1,VALMWD)
- I Y["FUTURE" S X=$E(X,1,SC-1)_$E($$LOWER(Y)_$$ANC_BL,1,SW+TW+1)
- S Y1=$S($P(SDSTAT,";",5):$P(SDSTAT,";",5),1:$P(SDSTAT,";",4)),Y1=$S($P(Y1,".")=DT:$$TIME($P(Y1,".",2)),1:"")
- S:Y1]"" X=$E(X,1,TC-1)_$E(Y1_BL,1,TW)_$E(X,TC+TW+1,VALMWD)
- D SET(X)
- I $D(SDAMBOLD(DFN,SDT,SDCL)) D FLDCTRL^VALM10(VALMCNT,"STAT",IOINHI,IOINORM),FLDCTRL^VALM10(VALMCNT,"TIME",IOINHI,IOINORM)
- S ^TMP("SDAMIDX",$J,SDACNT)=VALMCNT_U_DFN_U_SDT_U_SDCL_U_$S($D(SDDA):SDDA,1:"")
- BLD1Q Q
- ;
- ANC() ; -- set ancillary info
- N I,Y,C
- S Y="",C=0
- 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
- I Y]"" S Y="/"_$E(Y,2,99)
- Q Y
- ;
- SET(X) ;
- S VALMCNT=VALMCNT+1,^TMP("SDAM",$J,VALMCNT,0)=X
- S:SDACNT ^TMP("SDAM",$J,"IDX",VALMCNT,SDACNT)=""
- Q
- ;
- CHK(DFN,SDT,SDCL,SDATA,SDAMLIST,SDSTAT,SDDA) ; -- does appt meet criteria
- ; input: DFN := ifn of pat.
- ; SDT := appt d/t
- ; SDCL := ifn of clinic
- ; SDATA := 0th node of pat appt entry
- ; SDAMLIST := list definition
- ; SDSTAT := appt status data from $$STATUS call
- ; SDDA := ifn for ^SC(clinic,"S",date,1,ifn) {optional}
- ; output: [returned] := meets criteria for list [0 - no | 1 - yes ]
- ;
- S Y=0
- I $D(SDAMLIST(+SDSTAT)) S Y=1 G CHKQ
- I $P(SDAMLIST,U)="ALL" S Y=1
- I $P(SDAMLIST,U)="CHECKED IN" I $P(SDSTAT,";",3)="ACT REQ/CHECKED IN" S Y=1 ; - SD*5.3*445
- CHKQ I Y,$D(SDAMLIST("SCR")) X SDAMLIST("SCR") S Y=$T
- Q Y
- ;
- STATUS(DFN,SDT,SDCL,SDATA,SDDA) ; -- return appt status
- ; input: DFN := ifn of pat.
- ; SDT := appt d/t
- ; SDCL := ifn of clinic
- ; SDATA := 0th node of pat appt entry
- ; SDDA := ifn for ^SC(clinic,"S",date,1,ifn) {optional}
- ; output: [returned] := appt status ifn ^ status name ^ print status ^
- ; check in d/t ^ check out d/t ^ adm mvt ifn
- ;
- ;S = status ; C = ci/co indicator ; Y = 'C' node ; P = print status
- N S,C,Y,P,VADMVT,VAINDT,STATUS,SDSCE,SDIEN
- ;
- ; -- get data for evaluation
- S:'$G(SDDA) SDDA=+$$FIND^SDAM2(DFN,SDT,SDCL)
- S Y=$G(^SC(SDCL,"S",SDT,1,SDDA,"C"))
- ;retrieve CHECK OUT from OUTPATIENT ENCOUNTER file if not in Hospital Location file/PURGED or edited
- S SDSCE=$P($G(^DPT(DFN,"S",SDT,0)),U,20)
- I SDSCE D ;pointer to OE
- .I $P(Y,U,3)="" S $P(Y,U,3)=$P($G(^SCE(SDSCE,0)),U,7) ;check out date
- .S SDIEN=SDSCE_"," S STATUS=$$GET1^DIQ(409.68,SDIEN,.12)
- ;
- ; -- set initial status value ; non-count clinic?
- 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:"")
- I SDSCE&(S="NO ACTION TAKEN") S S=""
- ;
- ; -- inpatient?
- S VAINDT=SDT D ADM^VADPT2
- 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=""
- ;
- ; -- determine ci/co indicator
- S C=$S($P(Y,"^",3):"CHECKED OUT",Y:"CHECKED IN",S]"":"",SDT>(DT+.2359):"FUTURE",1:"NO ACTION TAKEN") S:S="" S=C
- ;
- I S="NO ACTION TAKEN",$P(SDT,".")=DT,C'["CHECKED" S C="TODAY"
- ; -- $$REQ & $$COCMP in SDM1A not used for speed
- I S="CHECKED OUT"!(S="CHECKED IN"),SDT'<$P(^DG(43,1,"SCLR"),U,23),'$P(SDATA,U,20) S S="NO ACTION TAKEN"
- ;
- ; -- determine print status
- S P=$S(S=C!(C=""):S,1:"")
- I P="" D
- .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
- .I S="NO ACTION TAKEN",C="CHECKED OUT"!(C="CHECKED IN") S P="ACT REQ/"_C D Q
- ..I SDSCE I $P($G(^SCE(SDSCE,0)),U,7) S P="CHECKED OUT"
- .S P=$S(S="NO ACTION TAKEN":S,1:$P(S," "))_"/"_C
- I S["INPATIENT",C="" D
- .I SDT>(DT+.2359) S P=$P(S," ")_"/FUTURE" Q
- .S P=$P(S," ")_"/NO ACT TAKN"
- I S["INPATIENT" G STATUSQ
- I S["NO-SHOW" G STATUSQ
- I $G(SDSCE) I $D(^SCE(SDSCE,0)) D
- .I $G(STATUS)="NON-COUNT" D Q
- ..I $P(Y,U,3) S P="NON-COUNT/CHECKED OUT" Q
- ..I +Y S P="NON-COUNT/CHECKED IN"
- .I $G(STATUS)="CHECKED OUT" S P="CHECKED OUT" Q
- .I $P(Y,U,3) S P="ACT REQ/CHECKED OUT" D Q
- ..I $G(STATUS)="ACTION REQUIRED" S S="NO ACTION TAKEN" Q
- ..I $G(STATUS)="" I $P($G(^SCE(SDSCE,0)),U,7) S P="CHECKED OUT"
- .I +Y S P="ACT REQ/CHECKED IN" D
- ..I $G(STATUS)="ACTION REQUIRED" S S="NO ACTION TAKEN"
- ;
- STATUSQ Q +$O(^SD(409.63,"AC",S,0))_";"_S_";"_P_";"_$P(Y,"^")_";"_$P(Y,"^",3)_";"_+VADMVT
- ;
- ;
- LOWER(X) ; convert to lowercase ; same as LOWER^VALM1 ; here for speed
- N Y,C,I
- S Y=$E(X)_$TR($E(X,2,999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ@","abcdefghijklmnopqrstuvwxyz ")
- 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)
- Q Y
- ;
- TIME(X) ; -- format time only := hr:min
- Q $E(X_"0000",1,2)_":"_$E(X_"0000",3,4)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDAM1 7044 printed Jan 18, 2025@03:48:13 Page 2
- SDAM1 ;MJK/ALB - Appt Mgt (Patient);Apr 23 1999
- +1 ;;5.3;Scheduling;**149,155,193,189,445,478,466,567,591,595**;Aug 13, 1993;Build 13
- +2 ;
- INIT ; -- get init pat appt data
- +1 ; input: DFN := ifn of pat
- +2 ; output: ^TMP("SDAM" := appt array
- +3 SET X=$PIECE($GET(^DG(43,1,"SCLR")),U,12)
- SET SDPRD=$SELECT(X:X,1:2)
- +4 SET X1=DT
- SET X2=-SDPRD
- DO C^%DTC
- SET SDBEG=X
- +5 SET X1=DT
- SET X2=999
- DO C^%DTC
- SET SDEND=X
- +6 DO CHGCAP^VALM("NAME","Clinic")
- +7 SET X="ALL"
- DO LIST^SDAM
- +8 QUIT
- +9 ;
- BLD ; -- scan apts
- +1 ; done for speed see INIT
- NEW SDAMDD,SDNAME,SDMAX,SDLARGE,DFN,SDCL,BL,XC,XW,AC,AW,TC,TW,NC,NW,SC,SW,SDT,CC,CW,CN,CNPAT,CNSTLNK,CSTAT
- +2 DO INIT^SDAM10
- +3 SET DFN=SDFN
- +4 ;SD/478
- FOR SDT=SDBEG:0
- SET SDT=$ORDER(^DPT(DFN,"S",SDT))
- if 'SDT!($PIECE(SDT,".",1)>SDEND)
- QUIT
- IF $DATA(^(SDT,0))
- SET SDATA=^(0)
- SET SDCL=+SDATA
- SET SDNAME=$PIECE($GET(^SC(SDCL,0)),U)
- Begin DoDot:1
- +5 ;SD/478
- SET CNSTLNK=""
- SET CN=0
- FOR
- SET CN=$ORDER(^SC(SDCL,"S",SDT,1,CN))
- if '+CN
- QUIT
- SET CNPAT=$PIECE($GET(^SC(SDCL,"S",SDT,1,CN,0)),U)
- IF CNPAT=DFN
- SET CNSTLNK=$PIECE($GET(^SC(SDCL,"S",SDT,1,CN,"CONS")),U)
- SET CSTAT=""
- if CNSTLNK'=""
- SET CSTAT=$PIECE($GET(^GMR(123,CNSTLNK,0)),U,12)
- QUIT
- End DoDot:1
- if CNSTLNK=""
- KILL CNSTLNK
- DO BLD1
- +6 DO NUL^SDAM10
- if $DATA(SDLARGE)
- DO LARGE^SDAM10
- +7 SET $PIECE(^TMP("SDAM",$JOB,0),U,4)=VALMCNT
- +8 QUIT
- +9 ;
- BLD1 ; -- build array
- +1 NEW SDX,X,Y,Y1,SDSTAT,SDELIG
- +2 SET SDSTAT=$$STATUS(DFN,SDT,SDCL,SDATA,$SELECT($DATA(SDDA):SDDA,1:""))
- +3 if '$$CHK(DFN,SDT,SDCL,SDATA,.SDAMLIST,SDSTAT)
- GOTO BLD1Q
- +4 ;; Changes for GAF enhancement
- +5 SET SDGAFREQ=" "
- +6 SET SDELIG=$$ELSTAT^SDUTL2(DFN)
- +7 IF $$MHCLIN^SDUTL2(SDCL)
- IF '($$COLLAT^SDUTL2(SDELIG)!$PIECE(SDATA,U,11))
- Begin DoDot:1
- +8 SET SDGAF=$$NEWGAF^SDUTL2(DFN)
- SET SDGAFST=$PIECE(SDGAF,"^")
- +9 if SDGAFST
- SET SDGAFREQ="*"
- End DoDot:1
- +10 SET SDACNT=SDACNT+1
- SET X=""
- SET $PIECE(X," ",VALMWD+1)=""
- +11 if (SDACNT#10)=0
- WRITE "."
- +12 IF SDACNT=SDMAX
- IF $PIECE(SDT,".")'=SDEND
- SET SDEND=$PIECE(SDT,".")
- SET SDLARGE=""
- +13 SET X=SDGAFREQ_$EXTRACT(X,2,AC-1)_$EXTRACT(SDACNT_BL,1,AW)_$EXTRACT(X,AC+AW+1,VALMWD)
- +14 SET X=$EXTRACT(X,1,NC-1)_$EXTRACT($$LOWER(SDNAME)_BL,1,NW)_$EXTRACT(X,NC+NW+1,VALMWD)
- +15 ;to make date field work for SD*5.3*189 - uses FM List Template
- SET X=$EXTRACT(X,1,XC-1)_$EXTRACT($$FMTE^XLFDT(SDT,"5Z")_BL,1,XW)_$EXTRACT(X,XC+XW+1,VALMWD)
- +16 ;SD/478
- if '$DATA(CSTAT)
- SET CSTAT=""
- +17 ;SD/478
- SET X=$EXTRACT(X,1,CC-1)_$EXTRACT($SELECT((CSTAT=1!(CSTAT=2)!(CSTAT=13)):" ",$GET(CNSTLNK):"Consult",1:" ")_BL,1,CW)_$EXTRACT(X,CC+CW+1,VALMWD)
- KILL CNSTLNK,CSTAT
- +18 SET Y=$PIECE(SDSTAT,";",3)
- +19 IF Y'["FUTURE"
- SET X=$EXTRACT(X,1,SC-1)_$EXTRACT($$LOWER(Y)_BL,1,SW)_$EXTRACT(X,SC+SW+1,VALMWD)
- +20 IF Y["FUTURE"
- SET X=$EXTRACT(X,1,SC-1)_$EXTRACT($$LOWER(Y)_$$ANC_BL,1,SW+TW+1)
- +21 SET Y1=$SELECT($PIECE(SDSTAT,";",5):$PIECE(SDSTAT,";",5),1:$PIECE(SDSTAT,";",4))
- SET Y1=$SELECT($PIECE(Y1,".")=DT:$$TIME($PIECE(Y1,".",2)),1:"")
- +22 if Y1]""
- SET X=$EXTRACT(X,1,TC-1)_$EXTRACT(Y1_BL,1,TW)_$EXTRACT(X,TC+TW+1,VALMWD)
- +23 DO SET(X)
- +24 IF $DATA(SDAMBOLD(DFN,SDT,SDCL))
- DO FLDCTRL^VALM10(VALMCNT,"STAT",IOINHI,IOINORM)
- DO FLDCTRL^VALM10(VALMCNT,"TIME",IOINHI,IOINORM)
- +25 SET ^TMP("SDAMIDX",$JOB,SDACNT)=VALMCNT_U_DFN_U_SDT_U_SDCL_U_$SELECT($DATA(SDDA):SDDA,1:"")
- BLD1Q QUIT
- +1 ;
- ANC() ; -- set ancillary info
- +1 NEW I,Y,C
- +2 SET Y=""
- SET C=0
- +3 FOR I=3:1:5
- IF $PIECE(SDATA,U,I)]""
- SET Y=Y_" "_$PIECE("^^Lab^XRay^EKG",U,I)_"@"_$$TIME($PIECE($PIECE(SDATA,U,I),".",2))
- SET C=C+1
- if C=2
- QUIT
- +4 IF Y]""
- SET Y="/"_$EXTRACT(Y,2,99)
- +5 QUIT Y
- +6 ;
- SET(X) ;
- +1 SET VALMCNT=VALMCNT+1
- SET ^TMP("SDAM",$JOB,VALMCNT,0)=X
- +2 if SDACNT
- SET ^TMP("SDAM",$JOB,"IDX",VALMCNT,SDACNT)=""
- +3 QUIT
- +4 ;
- CHK(DFN,SDT,SDCL,SDATA,SDAMLIST,SDSTAT,SDDA) ; -- does appt meet criteria
- +1 ; input: DFN := ifn of pat.
- +2 ; SDT := appt d/t
- +3 ; SDCL := ifn of clinic
- +4 ; SDATA := 0th node of pat appt entry
- +5 ; SDAMLIST := list definition
- +6 ; SDSTAT := appt status data from $$STATUS call
- +7 ; SDDA := ifn for ^SC(clinic,"S",date,1,ifn) {optional}
- +8 ; output: [returned] := meets criteria for list [0 - no | 1 - yes ]
- +9 ;
- +10 SET Y=0
- +11 IF $DATA(SDAMLIST(+SDSTAT))
- SET Y=1
- GOTO CHKQ
- +12 IF $PIECE(SDAMLIST,U)="ALL"
- SET Y=1
- +13 ; - SD*5.3*445
- IF $PIECE(SDAMLIST,U)="CHECKED IN"
- IF $PIECE(SDSTAT,";",3)="ACT REQ/CHECKED IN"
- SET Y=1
- CHKQ IF Y
- IF $DATA(SDAMLIST("SCR"))
- XECUTE SDAMLIST("SCR")
- SET Y=$TEST
- +1 QUIT Y
- +2 ;
- STATUS(DFN,SDT,SDCL,SDATA,SDDA) ; -- return appt status
- +1 ; input: DFN := ifn of pat.
- +2 ; SDT := appt d/t
- +3 ; SDCL := ifn of clinic
- +4 ; SDATA := 0th node of pat appt entry
- +5 ; SDDA := ifn for ^SC(clinic,"S",date,1,ifn) {optional}
- +6 ; output: [returned] := appt status ifn ^ status name ^ print status ^
- +7 ; check in d/t ^ check out d/t ^ adm mvt ifn
- +8 ;
- +9 ;S = status ; C = ci/co indicator ; Y = 'C' node ; P = print status
- +10 NEW S,C,Y,P,VADMVT,VAINDT,STATUS,SDSCE,SDIEN
- +11 ;
- +12 ; -- get data for evaluation
- +13 if '$GET(SDDA)
- SET SDDA=+$$FIND^SDAM2(DFN,SDT,SDCL)
- +14 SET Y=$GET(^SC(SDCL,"S",SDT,1,SDDA,"C"))
- +15 ;retrieve CHECK OUT from OUTPATIENT ENCOUNTER file if not in Hospital Location file/PURGED or edited
- +16 SET SDSCE=$PIECE($GET(^DPT(DFN,"S",SDT,0)),U,20)
- +17 ;pointer to OE
- IF SDSCE
- Begin DoDot:1
- +18 ;check out date
- IF $PIECE(Y,U,3)=""
- SET $PIECE(Y,U,3)=$PIECE($GET(^SCE(SDSCE,0)),U,7)
- +19 SET SDIEN=SDSCE_","
- SET STATUS=$$GET1^DIQ(409.68,SDIEN,.12)
- End DoDot:1
- +20 ;
- +21 ; -- set initial status value ; non-count clinic?
- +22 SET S=$SELECT($PIECE(SDATA,"^",2)]"":$PIECE($PIECE($PIECE(^DD(2.98,3,0),"^",3),$PIECE(SDATA,"^",2)_":",2),";"),$PIECE($GET(^SC(SDCL,0)),U,17)="Y":"NON-COUNT",1:"")
- +23 IF SDSCE&(S="NO ACTION TAKEN")
- SET S=""
- +24 ;
- +25 ; -- inpatient?
- +26 SET VAINDT=SDT
- DO ADM^VADPT2
- +27 IF S["INPATIENT"
- IF $SELECT('VADMVT:1,'$PIECE(^DG(43,1,0),U,21):0,1:$PIECE($GET(^DIC(42,+$PIECE($GET(^DGPM(VADMVT,0)),U,6),0)),U,3)="D")
- SET S=""
- +28 ;
- +29 ; -- determine ci/co indicator
- +30 SET C=$SELECT($PIECE(Y,"^",3):"CHECKED OUT",Y:"CHECKED IN",S]"":"",SDT>(DT+.2359):"FUTURE",1:"NO ACTION TAKEN")
- if S=""
- SET S=C
- +31 ;
- +32 IF S="NO ACTION TAKEN"
- IF $PIECE(SDT,".")=DT
- IF C'["CHECKED"
- SET C="TODAY"
- +33 ; -- $$REQ & $$COCMP in SDM1A not used for speed
- +34 IF S="CHECKED OUT"!(S="CHECKED IN")
- IF SDT'<$PIECE(^DG(43,1,"SCLR"),U,23)
- IF '$PIECE(SDATA,U,20)
- SET S="NO ACTION TAKEN"
- +35 ;
- +36 ; -- determine print status
- +37 SET P=$SELECT(S=C!(C=""):S,1:"")
- +38 IF P=""
- Begin DoDot:1
- +39 IF S["INPATIENT"
- IF $PIECE($GET(^SC(SDCL,0)),U,17)'="Y"
- IF $PIECE($GET(^SCE(+$PIECE(SDATA,U,20),0)),U,7)=""
- SET P=$PIECE(S," ")_"/ACT REQ"
- QUIT
- +40 IF S="NO ACTION TAKEN"
- IF C="CHECKED OUT"!(C="CHECKED IN")
- SET P="ACT REQ/"_C
- Begin DoDot:2
- +41 IF SDSCE
- IF $PIECE($GET(^SCE(SDSCE,0)),U,7)
- SET P="CHECKED OUT"
- End DoDot:2
- QUIT
- +42 SET P=$SELECT(S="NO ACTION TAKEN":S,1:$PIECE(S," "))_"/"_C
- End DoDot:1
- +43 IF S["INPATIENT"
- IF C=""
- Begin DoDot:1
- +44 IF SDT>(DT+.2359)
- SET P=$PIECE(S," ")_"/FUTURE"
- QUIT
- +45 SET P=$PIECE(S," ")_"/NO ACT TAKN"
- End DoDot:1
- +46 IF S["INPATIENT"
- GOTO STATUSQ
- +47 IF S["NO-SHOW"
- GOTO STATUSQ
- +48 IF $GET(SDSCE)
- IF $DATA(^SCE(SDSCE,0))
- Begin DoDot:1
- +49 IF $GET(STATUS)="NON-COUNT"
- Begin DoDot:2
- +50 IF $PIECE(Y,U,3)
- SET P="NON-COUNT/CHECKED OUT"
- QUIT
- +51 IF +Y
- SET P="NON-COUNT/CHECKED IN"
- End DoDot:2
- QUIT
- +52 IF $GET(STATUS)="CHECKED OUT"
- SET P="CHECKED OUT"
- QUIT
- +53 IF $PIECE(Y,U,3)
- SET P="ACT REQ/CHECKED OUT"
- Begin DoDot:2
- +54 IF $GET(STATUS)="ACTION REQUIRED"
- SET S="NO ACTION TAKEN"
- QUIT
- +55 IF $GET(STATUS)=""
- IF $PIECE($GET(^SCE(SDSCE,0)),U,7)
- SET P="CHECKED OUT"
- End DoDot:2
- QUIT
- +56 IF +Y
- SET P="ACT REQ/CHECKED IN"
- Begin DoDot:2
- +57 IF $GET(STATUS)="ACTION REQUIRED"
- SET S="NO ACTION TAKEN"
- End DoDot:2
- End DoDot:1
- +58 ;
- STATUSQ QUIT +$ORDER(^SD(409.63,"AC",S,0))_";"_S_";"_P_";"_$PIECE(Y,"^")_";"_$PIECE(Y,"^",3)_";"_+VADMVT
- +1 ;
- +2 ;
- LOWER(X) ; convert to lowercase ; same as LOWER^VALM1 ; here for speed
- +1 NEW Y,C,I
- +2 SET Y=$EXTRACT(X)_$TRANSLATE($EXTRACT(X,2,999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ@","abcdefghijklmnopqrstuvwxyz ")
- +3 FOR C=" ",",","/"
- SET I=0
- FOR
- SET I=$FIND(Y,C,I)
- if 'I
- QUIT
- SET Y=$EXTRACT(Y,1,I-1)_$TRANSLATE($EXTRACT(Y,I),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$EXTRACT(Y,I+1,999)
- +4 QUIT Y
- +5 ;
- TIME(X) ; -- format time only := hr:min
- +1 QUIT $EXTRACT(X_"0000",1,2)_":"_$EXTRACT(X_"0000",3,4)