- 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
