source: FOIAVistA/tag/r/NURSING_SERVICE-NUR/NURAGEN.m@ 628

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