ASDROUT2 ; IHS/ADC/PDW/ENM - RS HEADING (SHORT FORM) ; [ 03/25/1999 11:48 AM ]
;;5.0;IHS SCHEDULING;;MAR 25, 1999
;
HED ;EP -- rerouted from SDROUT2 if printing short form
I $G(SDCNT)>0 W @IOF
W !,"FACILITY: "
W $S($D(^DG(40.8,+DIV,0)):$P(^(0),U),1:^DD("SITE")) S P=P+1
W !,"PAGE ",P,?10,"OUTPATIENT ROUTING SLIP"
W !?7,"***",$$CONF1^ASDUT,"***"
S Y=^DPT(J,0),NAME=$E($P(Y,U,1),1,20),DOB=$P(Y,U,3)
W !,"NAME:",?7,NAME,?30,"HRCN: ",$$HRN^ASDUT(J)
S Y=DOB X ^DD("DD") W !,"DOB:",?7,Y,?27,"APPT DT: ",$$APDT
I $D(^DPT(J,.1)) D G OVR
. W !!,"*** INPATIENT ***"
. W ?20,"LOCATED ON WARD: ",$P(^DPT(J,.1),U,1),!
S ADDR=$S($D(^DPT(J,.11)):^DPT(J,.11),1:"")
OVR W !
Q
;
APDT() ;EP; returns printable appt date
Q $S(APDATE]"":APDATE,1:$$FMTE^XLFDT(DT,2))
;
SHORT() ;EP -- returns 1 is short rs form wanted
Q $S($G(ASDLONG):0,$P($G(^DG(40.8,$$DIV,"IHS")),U,2)="S":1,1:0)
;
DIV() ; -- returns division ien
Q +$O(^DG(40.8,"C",DUZ(2),0))
;
HD ;EP
W !,?11,"**CURRENT APPOINTMENTS**",!!,?3,"TIME",?11,"CLINIC"
Q
;
STATUS(DFN) ;EP; -- called to check if patient's chart is incomplete
; or pulled for day surgery
NEW X
Q:DFN=""
I $O(^ADGIC(DFN,"D",0)) D
. W !?5,"**Active Incomplete Chart**"
. S X=$O(^ADGIC(DFN,"D",0))
. I X]"",$P($G(^ADGIC(DFN,"D",X,0)),U,12)]"" D
.. W !?8,$P(^ADGIC(DFN,"D",X,0),U,12) ;comments
;
I $O(^ADGDSI(DFN,"DT",0)) D
. W !?5,"**Active DS Incomplete Chart**"
. S X=$O(^ADGDSI(DFN,"DT",0))
. I X]"",$P($G(^ADGDSI(DFN,"DT",X,0)),U,4)]"" D
.. W !?8,$P(^ADGDSI(DFN,"DT",X,0),U,4) ;comments
;
NEW X S X=$O(^ADGDS(DFN,"DS",DT))
I X]"",X\1=DT W !?5,"**Active Day Surgery Patient**"
;
NEW DATE,X S DATE=9999999-DT,X=DATE-.0001
S X=$O(^SRF("AIHS3",DFN,X)) Q:'X
I X\1=DATE W !?5,"**Day Surgery/SDA Patient**"
Q
ASDROUT2 ; IHS/ADC/PDW/ENM - RS HEADING (SHORT FORM) ; [ 03/25/1999 11:48 AM ]
+1 ;;5.0;IHS SCHEDULING;;MAR 25, 1999
+2 ;
HED ;EP -- rerouted from SDROUT2 if printing short form
+1 IF $GET(SDCNT)>0
WRITE @IOF
+2 WRITE !,"FACILITY: "
+3 WRITE $SELECT($DATA(^DG(40.8,+DIV,0)):$PIECE(^(0),U),1:^DD("SITE"))
SET P=P+1
+4 WRITE !,"PAGE ",P,?10,"OUTPATIENT ROUTING SLIP"
+5 WRITE !?7,"***",$$CONF1^ASDUT,"***"
+6 SET Y=^DPT(J,0)
SET NAME=$EXTRACT($PIECE(Y,U,1),1,20)
SET DOB=$PIECE(Y,U,3)
+7 WRITE !,"NAME:",?7,NAME,?30,"HRCN: ",$$HRN^ASDUT(J)
+8 SET Y=DOB
XECUTE ^DD("DD")
WRITE !,"DOB:",?7,Y,?27,"APPT DT: ",$$APDT
+9 IF $DATA(^DPT(J,.1))
Begin DoDot:1
+10 WRITE !!,"*** INPATIENT ***"
+11 WRITE ?20,"LOCATED ON WARD: ",$PIECE(^DPT(J,.1),U,1),!
End DoDot:1
GOTO OVR
+12 SET ADDR=$SELECT($DATA(^DPT(J,.11)):^DPT(J,.11),1:"")
OVR WRITE !
+1 QUIT
+2 ;
APDT() ;EP; returns printable appt date
+1 QUIT $SELECT(APDATE]"":APDATE,1:$$FMTE^XLFDT(DT,2))
+2 ;
SHORT() ;EP -- returns 1 is short rs form wanted
+1 QUIT $SELECT($GET(ASDLONG):0,$PIECE($GET(^DG(40.8,$$DIV,"IHS")),U,2)="S":1,1:0)
+2 ;
DIV() ; -- returns division ien
+1 QUIT +$ORDER(^DG(40.8,"C",DUZ(2),0))
+2 ;
HD ;EP
+1 WRITE !,?11,"**CURRENT APPOINTMENTS**",!!,?3,"TIME",?11,"CLINIC"
+2 QUIT
+3 ;
STATUS(DFN) ;EP; -- called to check if patient's chart is incomplete
+1 ; or pulled for day surgery
+2 NEW X
+3 IF DFN=""
QUIT
+4 IF $ORDER(^ADGIC(DFN,"D",0))
Begin DoDot:1
+5 WRITE !?5,"**Active Incomplete Chart**"
+6 SET X=$ORDER(^ADGIC(DFN,"D",0))
+7 IF X]""
IF $PIECE($GET(^ADGIC(DFN,"D",X,0)),U,12)]""
Begin DoDot:2
+8 ;comments
WRITE !?8,$PIECE(^ADGIC(DFN,"D",X,0),U,12)
End DoDot:2
End DoDot:1
+9 ;
+10 IF $ORDER(^ADGDSI(DFN,"DT",0))
Begin DoDot:1
+11 WRITE !?5,"**Active DS Incomplete Chart**"
+12 SET X=$ORDER(^ADGDSI(DFN,"DT",0))
+13 IF X]""
IF $PIECE($GET(^ADGDSI(DFN,"DT",X,0)),U,4)]""
Begin DoDot:2
+14 ;comments
WRITE !?8,$PIECE(^ADGDSI(DFN,"DT",X,0),U,4)
End DoDot:2
End DoDot:1
+15 ;
+16 NEW X
SET X=$ORDER(^ADGDS(DFN,"DS",DT))
+17 IF X]""
IF X\1=DT
WRITE !?5,"**Active Day Surgery Patient**"
+18 ;
+19 NEW DATE,X
SET DATE=9999999-DT
SET X=DATE-.0001
+20 SET X=$ORDER(^SRF("AIHS3",DFN,X))
IF 'X
QUIT
+21 IF X\1=DATE
WRITE !?5,"**Day Surgery/SDA Patient**"
+22 QUIT
