80 lines
4.9 KiB
Mathematica
80 lines
4.9 KiB
Mathematica
NURAGEN ;HIRMFO/JH,FT,MD-GENERIC REPORT GENERATOR FOR ADMIN. part 1 ;4/30/97
|
|
;;4.0;NURSING SERVICE;**1,13**;Apr 25, 1997
|
|
;LAST MODIFIED BY MD; MAR 95
|
|
;There are (2) segments of this print module which services 10 Routines
|
|
; A9A1,A9E1,A9F1,A9H1,A9J1
|
|
; A6A1,A6E1,A6F1,A6H1,A6J1
|
|
;
|
|
PRINT ; PRINT MODULE
|
|
D:$G(NURSUMSW)!'(NURMDSW) HEADER S (NPR0,NPR1,NPR2,NPR3,NPR4,NPR5,NPR6,NPC6,NPC7,NPC8,NX)="" D N
|
|
K X,Y,NURLINE,NPC1,NPC2,NPC3,NPC4,NPC5,NPC6,NPC7,NPC8,NPR0,NPR1,NPR2,NPR3,NPR4,NPR5,NPR6,NNURSX,NURAROU,NURSLEV,NURSSP
|
|
Q
|
|
N S NURFAC="" F S NURFAC=$O(^TMP($J,"L",NURFAC)) Q:NURFAC=""!(NURQUIT) D:$G(NURMDSW)&'$G(NURSUMSW) HEADER D P Q:$G(NURQUIT) D:NURMDSW FSUBTL^NURAGEN1 Q:NURQUIT
|
|
Q
|
|
P S NURPROG="" F S NURPROG=$O(^TMP($J,"L",NURFAC,NURPROG)) Q:NURPROG=""!(NURQUIT) D PROD,P0 Q:$G(NURQUIT) I NURPLSW,'$G(NURSUMSW) D PSUBTL^NURAGEN1 Q:NURQUIT
|
|
Q
|
|
P0 S NPC2="" F S NPC2=$O(^TMP($J,"L",NURFAC,NURPROG,NPC2)) Q:NPC2="" D P1 Q:NURQUIT I '$G(NURSUMSW),$G(NURPLSW) D HEADER Q:NURQUIT
|
|
Q
|
|
P1 S NPC3="" F S NPC3=$O(^TMP($J,"L",NURFAC,NURPROG,NPC2,NPC3)) Q:NPC3="" S:NURSLEV=3 NPC1=0 D P2 Q:NURQUIT
|
|
Q
|
|
P2 S NPC4="" F S NPC4=$O(^TMP($J,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4)) Q:NPC4="" S:NURSLEV=4 NPC1=0 S NURSORT=$G(^TMP($J,"L",NURFAC,NURPROG,NPC2,NPC3,NPC4)) I NURSORT D P3 Q:NURQUIT
|
|
Q
|
|
P3 S NPC5="" F S NPC5=$O(^TMP($J,"L1",NURSORT,NPC5)) Q:NPC5="" S:NURSLEV=5 NPC1=0 D P4:NURSLEV>3 Q:NURQUIT D PRINT1:NURSLEV=3
|
|
Q
|
|
P4 S NPC6="" F S NPC6=$O(^TMP($J,"L1",NURSORT,NPC5,NPC6)) Q:NPC6="" S:NURSLEV=6 NPC1=0 D P5:NURSLEV>4 Q:NURQUIT D PRINT1:NURSLEV=4
|
|
Q
|
|
P5 S NPC7="" F S NPC7=$O(^TMP($J,"L1",NURSORT,NPC5,NPC6,NPC7)) Q:NPC7="" D P6:NURSLEV>5 Q:NURQUIT D PRINT1:NURSLEV=5
|
|
Q
|
|
P6 I NURSLEV<7 S NPC8="" F S NPC8=$O(^TMP($J,"L1",NURSORT,NPC5,NPC6,NPC7,NPC8)) Q:NPC8=""!NURQUIT D PRINT1
|
|
Q
|
|
; DETAIL LINE PRINT ROUTINE
|
|
PRINT1 I ($Y>(IOSL-6)) D HEADER Q:NURQUIT
|
|
D ENT1^NURAGEN1
|
|
S NURSW1=1 W:NPC1=0&'($G(NURSUMSW)) ! S NPC1=NPC1+1 I NURROU=2!(NURROU=6)!(NURROU=10)!(NURROU=12)!(NURROU=16)!(NURROU=20) D PRI4 Q
|
|
D PRI1:(NURROU>0&(NURROU<7))!(NURROU=9)!(NURROU=10),PRI2:(NURROU=7)!(NURROU=8)!(NURROU=17),PRI3:(NURROU>10&(NURROU<17))!(NURROU>18&(NURROU<21)),PRI5:NURROU=18
|
|
Q
|
|
PRI1 W !,NPC1,?6,$E(NPR2,1,10),?17,$E(NPR3,1,10),?28,$E(NPR5,1,20),?52,NPR4
|
|
Q
|
|
PRI2 I NURROU=7!(NURROU=8) W !,NPC1,?6,$E(NPR2,1,10),?17,NPR3,?28,$E(NPR6,1,20),?50,NPR4,?65,NPR5 Q
|
|
W:'$G(NURSUMSW) !,NPC1,?6,$E(NPR2,1,10),?17,$E(NPR5,1,20),?40,NPR3,?59,NPR4
|
|
Q
|
|
PRI3 W:'$G(NURSUMSW) !,NPC1,?10,$E(NPR2,1,10),?23,$E(NPR4,1,20),?49,NPR3 ;ROU= 11 - 16
|
|
Q
|
|
PRI4 I NURROU=2!(NURROU=6)!(NURROU=10) W !,NPC1,?6,$S(NPC2'=" BLANK":$E(NPC2,1,10),1:""),?17,$S(NPC4'=" BLANK":NPC4,1:""),?28,$S(NPC6'=" BLANK":$E(NPC6,1,20),1:""),?52,$S(NPC5'=" BLANK":NPC5,1:"") Q
|
|
W:'$G(NURSUMSW) !,NPC1,?6,$S(NPC3'=" BLANK":$E(NPC3,1,10),1:""),?17,$S(NPC5'=" BLANK":$E(NPC5,1,20),1:""),?48,$S(NPC4'=" BLANK":NPC4,1:"")
|
|
Q
|
|
PRI5 W:'$G(NURSUMSW) !,NPC1,?6,$E(NPR2,1,10),?17,$E(NPR5,1,20),?45,NPR3,?61,NPR4 ;6H2
|
|
Q
|
|
HEADER ; HEADING SELECTION FOR GENERIC PRINT ROUTINES
|
|
S NX="" I (NURROU=12!(NURROU=14)!(NURROU=16)!(NURROU=18)!(NURROU=20)),'NURMDSW,'NURQUEUE,$E(IOST)="C",NURSW1,$Y<(IOSL-6) G NEXT1
|
|
I 'NURQUEUE,$E(IOST)="C",NURSW1 D ENDPG Q:$G(NURQUIT)
|
|
NEXT1 I (NURROU=12!(NURROU=14)!(NURROU=16)!(NURROU=18)!(NURROU=20)),'NURMDSW,$Y<(IOSL-6),NURSW1 G NEXTL
|
|
S NURPAGE=NURPAGE+1 W:$E(IOST)="C"!(NURPAGE>1) @IOF
|
|
I NURMDSW,'$G(NURSUMSW),$L($G(NURFAC))>1 W ?$$CNTR^NURSUT2(NURFAC),$$FACL^NURSUT2($G(NURFAC))
|
|
W !,NURSTIL S X="T" D ^%DT D:+Y D^DIQ W ?56,Y,?72,"PAGE: ",NURPAGE
|
|
W !!,NURSTIL1,!,NURSTIL2,!,$$REPEAT^XLFSTR("-",80) Q:'NURSW1
|
|
PROD I $G(NURPLSW),$L(NURPROG)>1,'$G(NURSUMSW) N Z S Z=$$PROD^NURSUT2($G(NURPROG)) W:$G(Z)'="" !!,?$$CNTR^NURSUT2(NURPROG),$G(Z),!,?$$CNTR^NURSUT2(NURPROG),$$REPEAT^XLFSTR("-",$L(Z)+1)
|
|
NEXTL S:NX="T" NURQUIT=1
|
|
Q
|
|
NODATA ;
|
|
I $O(^TMP($J,""))="",'$D(NURSNLOC) S NUROUT=1 S NURPROG=$S($G(NURPROG)=0:NURPROG(1),1:""),NURFAC=$S($G(NURFAC)=0:NURFAC(1),1:"") D HEADER W !!,"THERE IS NO DATA FOR THIS REPORT"
|
|
I $O(^TMP($J,""))="",$D(NURSNLOC) S NUROUT=1 S NURPROG=$S($G(NURPROG)=0:NURPROG(1),1:""),NURFAC=$S($G(NURFAC)=0:NURFAC(1),1:"") D HEADER S NL1="" F S NL1=$O(NURSNLOC(NL1)) Q:NL1="" D NODATA^NURSUT1
|
|
I $O(^TMP($J,""))'="",$D(NURSNLOC) D I NURSW1=1 D ENDPG^NURSUT1 S NURSW1=0
|
|
. S (NURY,NURZ,NURX)="" F S NURY=$O(^TMP($J,"L",NURY)) Q:NURY="" F S NURZ=$O(^TMP($J,"L",NURY,NURZ)) Q:NURZ="" F S NURX=$O(^TMP($J,"L",NURY,NURZ,NURX)) Q:NURX="" S ^TMP("NURLOC",$J,NURX)=""
|
|
. S NL1="" F S NL1=$O(NURSNLOC(NL1)) Q:NL1="" I '$D(^TMP("NURLOC",$J,NL1)) D
|
|
. . S NURPROG=$S($G(NURPROG)=0:NURPROG(1),1:""),NURFAC=$S($G(NURFAC)=0:NURFAC(1),1:"") D:NURSW1=0 HEADER S NURSW1=1 D NODATA^NURSUT1
|
|
. . Q
|
|
. Q
|
|
Q
|
|
CLOSE ; CLOSE DEVICE
|
|
W ! I '$G(NURQUIT) D ENDPG
|
|
D ^%ZISC
|
|
I $D(ZTQUEUED) S ZTREQ="@"
|
|
Q
|
|
ENDPG ; HANDLE EOP
|
|
I $E(IOST)'="C"!($G(NURQUIT)) Q
|
|
W $C(7),!!,"Press return to continue, ""T"" for totals, or ""^"" to exit: " R NX:DTIME
|
|
S NX=$$UP^XLFSTR(NX)
|
|
I '$T!(NX=U) S (NURQUIT,NUROUT)=1
|
|
Q
|