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 Jan 19, 2023@22:24:50 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