DGDISPL.m

DGDISPL ;ALB/JDS - DISPOSITION LOG ;1/8/91  13:25

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 ;

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

DGDISPL   ;ALB/JDS - DISPOSITION LOG ;1/8/91  13:25

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 +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