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 " "
Q
;
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
Q
;
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
Q
;
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
Q
;
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
Q
;
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 !
Q
;
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 Sep 23, 2025@20:25:36 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
