DGSCHAD3 ;ALB/MTC - OUTPUT FUTURE SCHEDULED ADMISSION DATA ;11 MAY 87
;;5.3;Registration;**60,71,957**;Aug 13, 1993;Build 2
;
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,DGFR1)=Y ;DG*5.3*957 Added DGFR1(From date) to =Y
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_".2400" ;DG*5.3*957 changed .9999 to .2400
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGSCHAD3 3028 printed Apr 09, 2024@21:38:34 Page 2
DGSCHAD3 ;ALB/MTC - OUTPUT FUTURE SCHEDULED ADMISSION DATA ;11 MAY 87
+1 ;;5.3;Registration;**60,71,957**;Aug 13, 1993;Build 2
+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 ;DG*5.3*957 Added DGFR1(From date) to =Y
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,DGFR1)=Y
+1 ;DG*5.3*957 changed .9999 to .2400
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_".2400"
+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
