DGDISPL ;ALB/JDS - DISPOSITION LOG ;1/8/91 13:25
;;5.3;Registration;;Aug 13, 1993
;
EN S Z="^In Process^ALL"
R !,"In process(I) or All(A): I// ",X:DTIME G Q:X["^"!'$T X:X="" "S X=""I"" W X" D IN^DGHELP I %=-1 W !!,"Enter 'I' to print only those dispositions in process,",!,"'A' to print all disposition's for a specified date range.",*7 G EN
H S DGS=0 I $D(^DG(43,1,"GL")) I $P(^("GL"),U,2) W !,"Sort by Facility" S %=1 D YN^DICN G Q:%=-1,HELP:'% S DGS=$S(%=1:1,1:0)
S DIC="^DPT(",L=0 G I:X="I" S FLDS="[DGDISPOSTIONS]",BY="1000,@.01;",FR="?",TO="?"
I DGS S BY="1000,'.01,1000,#3,1000,@99",FR="?,?,",TO="?,?,",DG1=0,DIS(0)="D DIS^DGDISPL:'DG1 S DG1=1 I 1"
W !!,*7,"Note: This report requires a column width of 132.",! D EN1^DIP
Q K IP,L,DIC,FLDS,FR,TO,DGS,DG1,%,Z,DIS,X,VA,VAERR Q
I S L=0,DIC="^DPT(",BY="1000,@50,1000,.01",FLDS="[DGOPENDISPOSITIONS]",DHD="OPEN DISPOSITIONS",FR=",",TO=FR
I DGS S BY="1000,'@50,1000,#3,1000,.01",FR=",?,",TO=FR
D EN1^DIP G Q
PRO S L2=+$P(L1,"^",6),L1=+L1,(TI,TO,PT)="",X=L1,DISP=$P(L,"^",7) D H^%DTC S LL1=%H,X=L2,LL2="" I X?7N.E D H^%DTC S LL2=%H
S TI=L1#1*10000,TI=$E("0000",1,4-$L(TI))_TI,TI=+$E(TI,1,2)_":"_$E(TI,3,4)
Q:'LL2 S X1=L1#1*10000,X2=L2#1*10000,TO=X2\100_":",X4=X2#100,TO=TO_$E("00",1,2-$L(X4))_X4 S:LL2-LL1 X2=X2+(LL2-LL1*2400\1) S X3=X2\100-(X1\100),X2=X2#100,X1=X1#100 S:X1>X2 X2=X2+60,X3=X3-1 S X4=X2-X1,X5=X3\24,X3=X3#24
S PT=$S(X5>0:X5_":",1:"")_$S(X5>0:$E("00",1,2-$L(X3)),1:"")_X3_":"_$E("00",1,2-$L(X4))_X4
Q
DIS I $D(DPP(1,"F")) S DPP(3,"F")=DPP(1,"F")
I $D(DPP(1,"T")) S DPP(3,"T")=DPP(1,"T")
Q
HELP W !,"Your facility is Multidivisonal",!,"Type 'Yes' to sort output by division",!,"This will add time to processing",! G H
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGDISPL 1719 printed Sep 23, 2025@20:17:56 Page 2
DGDISPL ;ALB/JDS - DISPOSITION LOG ;1/8/91 13:25
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;
EN SET Z="^In Process^ALL"
+1 READ !,"In process(I) or All(A): I// ",X:DTIME
if X["^"!'$TEST
GOTO Q
if X=""
XECUTE "S X=""I"" W X"
DO IN^DGHELP
IF %=-1
WRITE !!,"Enter 'I' to print only those dispositions in process,",!,"'A' to print all disposition's for a specified date range.",*7
GOTO EN
H SET DGS=0
IF $DATA(^DG(43,1,"GL"))
IF $PIECE(^("GL"),U,2)
WRITE !,"Sort by Facility"
SET %=1
DO YN^DICN
if %=-1
GOTO Q
if '%
GOTO HELP
SET DGS=$SELECT(%=1:1,1:0)
+1 SET DIC="^DPT("
SET L=0
if X="I"
GOTO I
SET FLDS="[DGDISPOSTIONS]"
SET BY="1000,@.01;"
SET FR="?"
SET TO="?"
+2 IF DGS
SET BY="1000,'.01,1000,#3,1000,@99"
SET FR="?,?,"
SET TO="?,?,"
SET DG1=0
SET DIS(0)="D DIS^DGDISPL:'DG1 S DG1=1 I 1"
+3 WRITE !!,*7,"Note: This report requires a column width of 132.",!
DO EN1^DIP
Q KILL IP,L,DIC,FLDS,FR,TO,DGS,DG1,%,Z,DIS,X,VA,VAERR
QUIT
I SET L=0
SET DIC="^DPT("
SET BY="1000,@50,1000,.01"
SET FLDS="[DGOPENDISPOSITIONS]"
SET DHD="OPEN DISPOSITIONS"
SET FR=","
SET TO=FR
+1 IF DGS
SET BY="1000,'@50,1000,#3,1000,.01"
SET FR=",?,"
SET TO=FR
+2 DO EN1^DIP
GOTO Q
PRO SET L2=+$PIECE(L1,"^",6)
SET L1=+L1
SET (TI,TO,PT)=""
SET X=L1
SET DISP=$PIECE(L,"^",7)
DO H^%DTC
SET LL1=%H
SET X=L2
SET LL2=""
IF X?7N.E
DO H^%DTC
SET LL2=%H
+1 SET TI=L1#1*10000
SET TI=$EXTRACT("0000",1,4-$LENGTH(TI))_TI
SET TI=+$EXTRACT(TI,1,2)_":"_$EXTRACT(TI,3,4)
+2 if 'LL2
QUIT
SET X1=L1#1*10000
SET X2=L2#1*10000
SET TO=X2\100_":"
SET X4=X2#100
SET TO=TO_$EXTRACT("00",1,2-$LENGTH(X4))_X4
if LL2-LL1
SET X2=X2+(LL2-LL1*2400\1)
SET X3=X2\100-(X1\100)
SET X2=X2#100
SET X1=X1#100
if X1>X2
SET X2=X2+60
SET X3=X3-1
SET X4=X2-X1
SET X5=X3\24
SET X3=X3#24
+3 SET PT=$SELECT(X5>0:X5_":",1:"")_$SELECT(X5>0:$EXTRACT("00",1,2-$LENGTH(X3)),1:"")_X3_":"_$EXTRACT("00",1,2-$LENGTH(X4))_X4
+4 QUIT
DIS IF $DATA(DPP(1,"F"))
SET DPP(3,"F")=DPP(1,"F")
+1 IF $DATA(DPP(1,"T"))
SET DPP(3,"T")=DPP(1,"T")
+2 QUIT
HELP WRITE !,"Your facility is Multidivisonal",!,"Type 'Yes' to sort output by division",!,"This will add time to processing",!
GOTO H
