Routine: DGPMGLP1

DGPMGLP1 ;ALB/LM - G&L PRINT ROUTINE; 8 NOV 90

 ;;5.3;Registration;;Aug 13, 1993

A I TT=6!(TT=9999)!(TT=8888),'SNM Q

 D TTHD,TT

Q Q

TTHD ;  Transaction Type

 S X1=132-$L(TTNAME)\2

 S TTNAME=$E(RA,1,X1-3)_"   "_TTNAME_"   "_$E(LA,1,X1-3)

TTHD1 D:$Y>$S($D(IOSL):(IOSL-11),1:55) FOOT^DGPMGLP,DIVHD^DGPMGLP

 W !?RM-($L(TTNAME))\2,TTNAME ; RM=Right Margin

 F L=1:1:(RM-($L(TTNAME))\2) W " "

TT S FM=0 ;  Facility Movement

 F I1=0:0 S FM=$O(^UTILITY("DGG",$J,DGDIV,DGSRV,TT,FM)) Q:'FM  S C=0,FMNAME=$S($D(^DG(405.1,+FM,0)):$P(^(0),"^"),1:"UNKNOWN MOVEMENT TYPE")_": "_$S($D(^UTILITY("DGF",$J,DGDIV,DGSRV,TT,FM)):$J(^(FM),4),1:"") D FMHD,FM

FMHD ;  Facility Movement

 D:$Y>$S($D(IOSL):(IOSL-9),1:57) FOOT^DGPMGLP,DIVHD^DGPMGLP,TTHD1

 W !?RM-($L(FMNAME))\2,FMNAME

 W:UL="-" ! W:UL="_" $C(13)

 F L=1:1:(RM-($L(FMNAME))\2) W " "

 F L=1:1:($L(FMNAME)) W UL

FM S PTNAME=0,PT=0

 S CT=0,CPZ=CP

 F I2=0:0 S PTNAME=$O(^UTILITY("DGG",$J,DGDIV,DGSRV,TT,FM,PTNAME)),DFN=0 Q:PTNAME=""  F I3=0:0 S DFN=$O(^UTILITY("DGG",$J,DGDIV,DGSRV,TT,FM,PTNAME,DFN)) Q:'DFN  S CT=CT+1

 S PO=1,CC=1

 D:CPZ=2 TWO D:CPZ=3 THREE

TWO Q:CPZ'=2

 S SC=$S(CT#CPZ>0:(CT\CPZ+2),1:CT\CPZ+1)

 F J2=0:0 S PT=$O(^UTILITY("DGG",$J,DGDIV,DGSRV,TT,FM,PT)),NZ=0 Q:PT=""  F J3=0:0 S NZ=$O(^UTILITY("DGG",$J,DGDIV,DGSRV,TT,FM,PT,NZ)) Q:'NZ  S PO=$S(CC=1:1,CC=SC:2,1:PO+2) S CC=CC+1 S PTDATA(PO)=^UTILITY("DGG",$J,DGDIV,DGSRV,TT,FM,PT,NZ)

PRINT2 F PO=0:0 S PO=$O(PTDATA(PO)) Q:PO=""  D:$Y>$S($D(IOSL):(IOSL-7),1:59) CONT D PRINT2A

TWOQ K SC,J2,PT,NZ,J3,PTDATA,CC,PO Q

CONT D FOOT^DGPMGLP,DIVHD^DGPMGLP,SRVHD^DGPMGLP

 I TTNAME'["Cont." S TTNAME=$P(TTNAME,":")_" Cont.   "_$E(LA,1,X1-3)

 D TTHD1

 I FMNAME'["Cont." S FMNAME=$P(FMNAME,":")_" Cont."

 D FMHD

PRINT2A I PO#CPZ>0!($L($P(PTDATA(PO),"^"))'<66) W !,$P(PTDATA(PO),"^")

 I PO#CPZ=0!(PO=2)&($L($P(PTDATA(PO),"^"))<66) W ?68,$P(PTDATA(PO),"^") I $Y=$S($D(IOSL):(IOSL-7),1:59) W !

THREE Q:CPZ'=3

 I CT#CPZ=0 S SC=CT+CPZ S TC=SC+CPZ

 I CT#CPZ=1 S SC=CT\CPZ+2 S TC=SC+CT\CPZ

 I CT#CPZ=2 S SC=CT\CPZ+(CT#CPZ) S TC=SC+(CT\CPZ)+1

 F J2=0:0 S PT=$O(^UTILITY("DGG",$J,DGDIV,DGSRV,TT,FM,PT)),NZ=0 Q:PT=""  F J3=0:0 S NZ=$O(^UTILITY("DGG",$J,DGDIV,DGSRV,TT,FM,PT,NZ)) Q:'NZ  S PTDATA(PO)=^UTILITY("DGG",$J,DGDIV,DGSRV,TT,FM,PT,NZ) S CC=CC+1 S PO=$S(CC=SC:2,CC=TC:3,1:PO+3)

PRINT3 F PO=0:0 S PO=$O(PTDATA(PO)) Q:PO=""  W:PO#CPZ=1!($P(PTDATA(PO),"^",2)) ! W:PO#CPZ=2&('$P(PTDATA(PO),"^",2)) ?44 W:PO#CPZ=0&('$P(PTDATA(PO),"^",2)) ?88 W $P(PTDATA(PO),"^")

THREEQQ K SC,TC,J2,PT,NZ,J3,PTDATA,CC,PO Q

VAR ; CPZ=Column Placement

 ; CT=Count of patients

 ; SC=Second Column starting point

 ; TC=Third Column starting point

 ; PO=Print Order

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMGLP1   2757     printed  Mar 13, 2025@21:54:28                                                                                                                                                                                                    Page 2

DGPMGLP1  ;ALB/LM - G&L PRINT ROUTINE; 8 NOV 90

 +1       ;;5.3;Registration;;Aug 13, 1993

 +2       ;

A          IF TT=6!(TT=9999)!(TT=8888)

               IF 'SNM

                   QUIT

 +1        DO TTHD

           DO TT

 +2       ;

Q          QUIT

 +1       ;

TTHD      ;  Transaction Type

 +1        SET X1=132-$LENGTH(TTNAME)\2

 +2        SET TTNAME=$EXTRACT(RA,1,X1-3)_"   "_TTNAME_"   "_$EXTRACT(LA,1,X1-3)

TTHD1      if $Y>$SELECT($DATA(IOSL)

               DO FOOT^DGPMGLP

               DO DIVHD^DGPMGLP

 +1       ; RM=Right Margin

           WRITE !?RM-($LENGTH(TTNAME))\2,TTNAME

 +2        FOR L=1:1:(RM-($LENGTH(TTNAME))\2)

               WRITE " "

 +3        QUIT

 +4       ;

TT        ;  Facility Movement

           SET FM=0

 +1        FOR I1=0:0

               SET FM=$ORDER(^UTILITY("DGG",$JOB,DGDIV,DGSRV,TT,FM))

               if 'FM

                   QUIT

               SET C=0

               SET FMNAME=$SELECT($DATA(^DG(405.1,+FM,0)):$PIECE(^(0),"^"),1:"UNKNOWN MOVEMENT TYPE")_": "_$SELECT($DATA(^UTILITY("DGF",$JOB,DGDIV,DGSRV,TT,FM)):$JUSTIFY(^(FM),4),1:"")

               DO FMHD

               DO FM

 +2        QUIT

 +3       ;

FMHD      ;  Facility Movement

 +1        if $Y>$SELECT($DATA(IOSL)

               DO FOOT^DGPMGLP

               DO DIVHD^DGPMGLP

               DO TTHD1

 +2        WRITE !?RM-($LENGTH(FMNAME))\2,FMNAME

 +3        if UL="-"

               WRITE !

           if UL="_"

               WRITE $CHAR(13)

 +4        FOR L=1:1:(RM-($LENGTH(FMNAME))\2)

               WRITE " "

 +5        FOR L=1:1:($LENGTH(FMNAME))

               WRITE UL

 +6        QUIT

 +7       ;

FM         SET PTNAME=0

           SET PT=0

 +1        SET CT=0

           SET CPZ=CP

 +2        FOR I2=0:0

               SET PTNAME=$ORDER(^UTILITY("DGG",$JOB,DGDIV,DGSRV,TT,FM,PTNAME))

               SET DFN=0

               if PTNAME=""

                   QUIT

               FOR I3=0:0

                   SET DFN=$ORDER(^UTILITY("DGG",$JOB,DGDIV,DGSRV,TT,FM,PTNAME,DFN))

                   if 'DFN

                       QUIT

                   SET CT=CT+1

 +3        SET PO=1

           SET CC=1

 +4        if CPZ=2

               DO TWO

           if CPZ=3

               DO THREE

 +5        QUIT

 +6       ;

TWO        if CPZ'=2

               QUIT

 +1        SET SC=$SELECT(CT#CPZ>0:(CT\CPZ+2),1:CT\CPZ+1)

 +2       ;

 +3        FOR J2=0:0

               SET PT=$ORDER(^UTILITY("DGG",$JOB,DGDIV,DGSRV,TT,FM,PT))

               SET NZ=0

               if PT=""

                   QUIT

               FOR J3=0:0

                   SET NZ=$ORDER(^UTILITY("DGG",$JOB,DGDIV,DGSRV,TT,FM,PT,NZ))

                   if 'NZ

                       QUIT

                   SET PO=$SELECT(CC=1:1,CC=SC:2,1:PO+2)

                   SET CC=CC+1

                   SET PTDATA(PO)=^UTILITY("DGG",$JOB,DGDIV,DGSRV,TT,FM,PT,NZ)

 +4       ;

PRINT2     FOR PO=0:0

               SET PO=$ORDER(PTDATA(PO))

               if PO=""

                   QUIT

               if $Y>$SELECT($DATA(IOSL)

                   DO CONT

               DO PRINT2A

 +1       ;

TWOQ       KILL SC,J2,PT,NZ,J3,PTDATA,CC,PO

           QUIT

 +1       ;

CONT       DO FOOT^DGPMGLP

           DO DIVHD^DGPMGLP

           DO SRVHD^DGPMGLP

 +1        IF TTNAME'["Cont."

               SET TTNAME=$PIECE(TTNAME,":")_" Cont.   "_$EXTRACT(LA,1,X1-3)

 +2        DO TTHD1

 +3        IF FMNAME'["Cont."

               SET FMNAME=$PIECE(FMNAME,":")_" Cont."

 +4        DO FMHD

 +5        QUIT

 +6       ;

PRINT2A    IF PO#CPZ>0!($LENGTH($PIECE(PTDATA(PO),"^"))'<66)

               WRITE !,$PIECE(PTDATA(PO),"^")

 +1        IF PO#CPZ=0!(PO=2)&($LENGTH($PIECE(PTDATA(PO),"^"))<66)

               WRITE ?68,$PIECE(PTDATA(PO),"^")

               IF $Y=$SELECT($DATA(IOSL):(IOSL-7),1:59)

                   WRITE !

 +2        QUIT

 +3       ;

THREE      if CPZ'=3

               QUIT

 +1        IF CT#CPZ=0

               SET SC=CT+CPZ

               SET TC=SC+CPZ

 +2        IF CT#CPZ=1

               SET SC=CT\CPZ+2

               SET TC=SC+CT\CPZ

 +3        IF CT#CPZ=2

               SET SC=CT\CPZ+(CT#CPZ)

               SET TC=SC+(CT\CPZ)+1

 +4       ;

 +5        FOR J2=0:0

               SET PT=$ORDER(^UTILITY("DGG",$JOB,DGDIV,DGSRV,TT,FM,PT))

               SET NZ=0

               if PT=""

                   QUIT

               FOR J3=0:0

                   SET NZ=$ORDER(^UTILITY("DGG",$JOB,DGDIV,DGSRV,TT,FM,PT,NZ))

                   if 'NZ

                       QUIT

                   SET PTDATA(PO)=^UTILITY("DGG",$JOB,DGDIV,DGSRV,TT,FM,PT,NZ)

                   SET CC=CC+1

                   SET PO=$SELECT(CC=SC:2,CC=TC:3,1:PO+3)

 +6       ;

PRINT3     FOR PO=0:0

               SET PO=$ORDER(PTDATA(PO))

               if PO=""

                   QUIT

               if PO#CPZ=1!($PIECE(PTDATA(PO),"^",2))

                   WRITE !

               if PO#CPZ=2&('$PIECE(PTDATA(PO),"^",2))

                   WRITE ?44

               if PO#CPZ=0&('$PIECE(PTDATA(PO),"^",2))

                   WRITE ?88

               WRITE $PIECE(PTDATA(PO),"^")

THREEQQ    KILL SC,TC,J2,PT,NZ,J3,PTDATA,CC,PO

           QUIT

 +1       ;

VAR       ; CPZ=Column Placement

 +1       ; CT=Count of patients

 +2       ; SC=Second Column starting point

 +3       ; TC=Third Column starting point

 +4       ; PO=Print Order

DGPMGLP1.m