source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPMGLP1.m@ 648

Last change on this file since 648 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1DGPMGLP1 ;ALB/LM - G&L PRINT ROUTINE; 8 NOV 90
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4A I TT=6!(TT=9999)!(TT=8888),'SNM Q
5 D TTHD,TT
6 ;
7Q Q
8 ;
9TTHD ; Transaction Type
10 S X1=132-$L(TTNAME)\2
11 S TTNAME=$E(RA,1,X1-3)_" "_TTNAME_" "_$E(LA,1,X1-3)
12TTHD1 D:$Y>$S($D(IOSL):(IOSL-11),1:55) FOOT^DGPMGLP,DIVHD^DGPMGLP
13 W !?RM-($L(TTNAME))\2,TTNAME ; RM=Right Margin
14 F L=1:1:(RM-($L(TTNAME))\2) W " "
15 Q
16 ;
17TT S FM=0 ; Facility Movement
18 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
19 Q
20 ;
21FMHD ; Facility Movement
22 D:$Y>$S($D(IOSL):(IOSL-9),1:57) FOOT^DGPMGLP,DIVHD^DGPMGLP,TTHD1
23 W !?RM-($L(FMNAME))\2,FMNAME
24 W:UL="-" ! W:UL="_" $C(13)
25 F L=1:1:(RM-($L(FMNAME))\2) W " "
26 F L=1:1:($L(FMNAME)) W UL
27 Q
28 ;
29FM S PTNAME=0,PT=0
30 S CT=0,CPZ=CP
31 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
32 S PO=1,CC=1
33 D:CPZ=2 TWO D:CPZ=3 THREE
34 Q
35 ;
36TWO Q:CPZ'=2
37 S SC=$S(CT#CPZ>0:(CT\CPZ+2),1:CT\CPZ+1)
38 ;
39 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)
40 ;
41PRINT2 F PO=0:0 S PO=$O(PTDATA(PO)) Q:PO="" D:$Y>$S($D(IOSL):(IOSL-7),1:59) CONT D PRINT2A
42 ;
43TWOQ K SC,J2,PT,NZ,J3,PTDATA,CC,PO Q
44 ;
45CONT D FOOT^DGPMGLP,DIVHD^DGPMGLP,SRVHD^DGPMGLP
46 I TTNAME'["Cont." S TTNAME=$P(TTNAME,":")_" Cont. "_$E(LA,1,X1-3)
47 D TTHD1
48 I FMNAME'["Cont." S FMNAME=$P(FMNAME,":")_" Cont."
49 D FMHD
50 Q
51 ;
52PRINT2A I PO#CPZ>0!($L($P(PTDATA(PO),"^"))'<66) W !,$P(PTDATA(PO),"^")
53 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 !
54 Q
55 ;
56THREE Q:CPZ'=3
57 I CT#CPZ=0 S SC=CT+CPZ S TC=SC+CPZ
58 I CT#CPZ=1 S SC=CT\CPZ+2 S TC=SC+CT\CPZ
59 I CT#CPZ=2 S SC=CT\CPZ+(CT#CPZ) S TC=SC+(CT\CPZ)+1
60 ;
61 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)
62 ;
63PRINT3 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),"^")
64THREEQQ K SC,TC,J2,PT,NZ,J3,PTDATA,CC,PO Q
65 ;
66VAR ; CPZ=Column Placement
67 ; CT=Count of patients
68 ; SC=Second Column starting point
69 ; TC=Third Column starting point
70 ; PO=Print Order
Note: See TracBrowser for help on using the repository browser.