- DGSCHAD3 ;ALB/MTC - OUTPUT FUTURE SCHEDULED ADMISSION DATA ; 11 MAY 87
- ;;5.3;Registration;**60,71,1015**;Aug 13, 1993;Build 21
- ;
- D OLD^DGSCHAD2 G Q:DGERR!(DGOLD=0) S Y=$S(DT<DGOLD1:DGOLD1,1:DT) X ^DD("DD") S DGTD=Y
- F W ! S %DT("A")="Start with DATE OF RESERVATION: ",%DT("B")=DGTD,%DT="EAX",%DT(0)=DGOLD1 D ^%DT K %DT G Q:Y'>0 S (DGFR,DGHFR)=Y,X1=DGFR,X2=-1 D C^%DTC S DGFR1=X_".9999"
- W ! S Y=DGFR X ^DD("DD") S DGFR=Y,%DT("A")=" Go to DATE OF RESERVATION: ",%DT("B")=Y,%DT="EAX",%DT(0)=DGHFR K DGHFR D ^%DT K %DT G Q:Y'>0 S DGTO1=Y X ^DD("DD") S DGTO=Y,DGTO1=DGTO1_".9999"
- S DHD="Scheduled Admission List for "_$S(DGTO'=DGFR:"period covering ",1:"")_DGFR_$S(DGTO'=DGFR:" through "_DGTO,1:"")_"."
- 1 D H^DGUTL S Z="^SCHEDULED^CANCELLED^BOTH^" R !!,"List (S)cheduled, (C)ancelled or (B)oth scheduled admissions: BOTH// ",X:DTIME S:'$T X="^" W:X="" "B" S:X="" X="B" D IN^DGHELP I X["^" G Q
- I %=-1 W !!?4,"C - To list only future scheduled admissions which have been cancelled.",!?4,"S - To list only active future scheduled admissions.",!?4,"B - To list all future scheduled admissions regardless of status." G 1
- S DGSCH=X,(BY,FR,TO)="" D DIV^DGUTL I DGDIV G 2
- D DIVISION^VAUTOMA G:VAUTD']""&('$O(VAUTD(0)))!(Y=-1) Q
- I VAUTD=1 S BY="12,",FR=FR_"@,",TO=TO_"," G 2
- S DGDIV=0,BY="12," K TO,FR S TO(1)="",FR(1)=""
- N DIS S DIS(0)="I VAUTD!$D(VAUTD(+$P(^DGS(41.1,D0,0),""^"",12)))"
- D H^DGUTL S BY=BY_"@2,.01,",FR(2)=DGFR1,FR(3)="",TO(2)=DGTO1,TO(3)="" I "SC"[DGSCH S BY=BY_"'13" S:DGSCH="S" TO(4)="@",FR(4)="@" I DGSCH="C" S TO(4)="",FR(4)=""
- G 3
- 2 D H^DGUTL S BY=BY_"@2,.01,",FR=FR_DGFR1_",,",TO=TO_DGTO1_",," I "SC"[DGSCH S BY=BY_"'13" S:DGSCH="S" TO=TO_"@,",FR=FR_"@," I DGSCH="C" S TO=TO_",",FR=FR_","
- 3 S DGNO=0 S X=1 D ^DGTEMP G Q:DGNO S FLDS=X,L=0,DIC="^DGS(41.1," W !!?15,*7,"This output requires 132 columns",!! D EN1^DIP
- Q K X,DGERR,DGOLD,DGOLD1,DGNO,DGTEMP,DGDIV,DGSCH,DGDATE,DGTIME Q
- TEMP S DGSA=^DGS(41.1,D0,0),DFN=+DGSA,DGPT=$S($D(^DPT(DFN,0)):^(0),1:""),Y=$P(DGSA,U,2) X ^DD("DD") W ?28,$E($P(DGPT,U,9),6,9),?35,"Phone: ",$S($D(^DPT(DFN,.13)):$P(^(.13),U),1:"UNKNOWN"),?60,"Reservation: ",Y
- W ?95,$S($P(DGSA,U,10)="W":"Ward Loc: "_$S($D(^DIC(42,+$P(DGSA,U,8),0)):$P(^(0),U),1:"UNKNOWN"),$P(DGSA,U,10)="T":"Treat Sp: "_$S($D(^DIC(45.7,+$P(DGSA,U,9),0)):$P(^(0),U),1:"UNKNOWN"),1:"")
- W !?32,"Provider: "_$S($P(DGSA,U,5)]""&($D(^VA(200,+$P(DGSA,U,5),0))):$P(^(0),U),1:"UNKNOWN"),?96,"Surgery: "_$S($P(DGSA,U,6)="Y":"YES",$P(DGSA,U,6)="N":"NO",1:"UNKNOWN")
- W !?34,"Status: " I $P(DGSA,U,13)']""&($P(DGSA,U,17)']"") W "SCHEDULED - Admitting Diagnosis '"_$S($P(DGSA,U,4)]"":$P(DGSA,U,4),1:"UNKNOWN")_"',"
- I ($P(DGSA,U,13)']"")&($P(DGSA,U,17)]"") W "ADMITTED - " I $D(^DGPM($P(DGSA,U,17),0)) S Y=$P(^DGPM($P(DGSA,U,17),0),U) D DD^%DT W Y
- I $P(DGSA,U,13)]"" W "CANCELLED by: "_$S($P(DGSA,U,14)]"":$P(^VA(200,$P(DGSA,U,14),0),U),1:"UNKNOWN")
- I DGPT']"" W !,"**PATIENT DELETED FROM PATIENT FILE - CONTACT IRM SERVICE",!!
- K DGSA,DFN,DGPT,Y
- DGSCHAD3 ;ALB/MTC - OUTPUT FUTURE SCHEDULED ADMISSION DATA ; 11 MAY 87
- +1 ;;5.3;Registration;**60,71,1015**;Aug 13, 1993;Build 21
- +2 ;
- +3 DO OLD^DGSCHAD2
- IF DGERR!(DGOLD=0)
- GOTO Q
- SET Y=$SELECT(DT<DGOLD1:DGOLD1,1:DT)
- XECUTE ^DD("DD")
- SET DGTD=Y
- F WRITE !
- SET %DT("A")="Start with DATE OF RESERVATION: "
- SET %DT("B")=DGTD
- SET %DT="EAX"
- SET %DT(0)=DGOLD1
- DO ^%DT
- KILL %DT
- IF Y'>0
- GOTO Q
- SET (DGFR,DGHFR)=Y
- SET X1=DGFR
- SET X2=-1
- DO C^%DTC
- SET DGFR1=X_".9999"
- +1 WRITE !
- SET Y=DGFR
- XECUTE ^DD("DD")
- SET DGFR=Y
- SET %DT("A")=" Go to DATE OF RESERVATION: "
- SET %DT("B")=Y
- SET %DT="EAX"
- SET %DT(0)=DGHFR
- KILL DGHFR
- DO ^%DT
- KILL %DT
- IF Y'>0
- GOTO Q
- SET DGTO1=Y
- XECUTE ^DD("DD")
- SET DGTO=Y
- SET DGTO1=DGTO1_".9999"
- +2 SET DHD="Scheduled Admission List for "_$SELECT(DGTO'=DGFR:"period covering ",1:"")_DGFR_$SELECT(DGTO'=DGFR:" through "_DGTO,1:"")_"."
- 1 DO H^DGUTL
- SET Z="^SCHEDULED^CANCELLED^BOTH^"
- READ !!,"List (S)cheduled, (C)ancelled or (B)oth scheduled admissions: BOTH// ",X:DTIME
- IF '$TEST
- SET X="^"
- IF X=""
- WRITE "B"
- IF X=""
- SET X="B"
- DO IN^DGHELP
- IF X["^"
- GOTO Q
- +1 IF %=-1
- WRITE !!?4,"C - To list only future scheduled admissions which have been cancelled.",!?4,"S - To list only active future scheduled admissions.",!?4,"B - To list all future scheduled admissions regardless of status."
- GOTO 1
- +2 SET DGSCH=X
- SET (BY,FR,TO)=""
- DO DIV^DGUTL
- IF DGDIV
- GOTO 2
- +3 DO DIVISION^VAUTOMA
- IF VAUTD']""&('$ORDER(VAUTD(0)))!(Y=-1)
- GOTO Q
- +4 IF VAUTD=1
- SET BY="12,"
- SET FR=FR_"@,"
- SET TO=TO_","
- GOTO 2
- +5 SET DGDIV=0
- SET BY="12,"
- KILL TO,FR
- SET TO(1)=""
- SET FR(1)=""
- +6 NEW DIS
- SET DIS(0)="I VAUTD!$D(VAUTD(+$P(^DGS(41.1,D0,0),""^"",12)))"
- +7 DO H^DGUTL
- SET BY=BY_"@2,.01,"
- SET FR(2)=DGFR1
- SET FR(3)=""
- SET TO(2)=DGTO1
- SET TO(3)=""
- IF "SC"[DGSCH
- SET BY=BY_"'13"
- IF DGSCH="S"
- SET TO(4)="@"
- SET FR(4)="@"
- IF DGSCH="C"
- SET TO(4)=""
- SET FR(4)=""
- +8 GOTO 3
- 2 DO H^DGUTL
- SET BY=BY_"@2,.01,"
- SET FR=FR_DGFR1_",,"
- SET TO=TO_DGTO1_",,"
- IF "SC"[DGSCH
- SET BY=BY_"'13"
- IF DGSCH="S"
- SET TO=TO_"@,"
- SET FR=FR_"@,"
- IF DGSCH="C"
- SET TO=TO_","
- SET FR=FR_","
- 3 SET DGNO=0
- SET X=1
- DO ^DGTEMP
- IF DGNO
- GOTO Q
- SET FLDS=X
- SET L=0
- SET DIC="^DGS(41.1,"
- WRITE !!?15,*7,"This output requires 132 columns",!!
- DO EN1^DIP
- Q KILL X,DGERR,DGOLD,DGOLD1,DGNO,DGTEMP,DGDIV,DGSCH,DGDATE,DGTIME
- QUIT
- TEMP SET DGSA=^DGS(41.1,D0,0)
- SET DFN=+DGSA
- SET DGPT=$SELECT($DATA(^DPT(DFN,0)):^(0),1:"")
- SET Y=$PIECE(DGSA,U,2)
- XECUTE ^DD("DD")
- WRITE ?28,$EXTRACT($PIECE(DGPT,U,9),6,9),?35,"Phone: ",$SELECT($DATA(^DPT(DFN,.13)):$PIECE(^(.13),U),1:"UNKNOWN"),?60,"Reservation: ",Y
- +1 WRITE ?95,$SELECT($PIECE(DGSA,U,10)="W":"Ward Loc: "_$SELECT($DATA(^DIC(42,+$PIECE(DGSA,U,8),0)):$PIECE(^(0),U),1:"UNKNOWN"),$PIECE(DGSA,U,10)="T":"Treat Sp: "_$SELECT($DATA(^DIC(45.7,+$PIECE(DGSA,U,9),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"")
- +2 WRITE !?32,"Provider: "_$SELECT($PIECE(DGSA,U,5)]""&($DATA(^VA(200,+$PIECE(DGSA,U,5),0))):$PIECE(^(0),U),1:"UNKNOWN"),?96,"Surgery: "_$SELECT($PIECE(DGSA,U,6)="Y":"YES",$PIECE(DGSA,U,6)="N":"NO",1:"UNKNOWN")
- +3 WRITE !?34,"Status: "
- IF $PIECE(DGSA,U,13)']""&($PIECE(DGSA,U,17)']"")
- WRITE "SCHEDULED - Admitting Diagnosis '"_$SELECT($PIECE(DGSA,U,4)]"":$PIECE(DGSA,U,4),1:"UNKNOWN")_"',"
- +4 IF ($PIECE(DGSA,U,13)']"")&($PIECE(DGSA,U,17)]"")
- WRITE "ADMITTED - "
- IF $DATA(^DGPM($PIECE(DGSA,U,17),0))
- SET Y=$PIECE(^DGPM($PIECE(DGSA,U,17),0),U)
- DO DD^%DT
- WRITE Y
- +5 IF $PIECE(DGSA,U,13)]""
- WRITE "CANCELLED by: "_$SELECT($PIECE(DGSA,U,14)]"":$PIECE(^VA(200,$PIECE(DGSA,U,14),0),U),1:"UNKNOWN")
- +6 IF DGPT']""
- WRITE !,"**PATIENT DELETED FROM PATIENT FILE - CONTACT IRM SERVICE",!!
- +7 KILL DGSA,DFN,DGPT,Y
