NURSEPC1 ;HIRMFO/MD,FT-AA/FUNDING REQUEST,PRINT (132 COLUMN REPORT) CON'T ;8/9/96 12:06
;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; Called by NURSEPCA
I $O(^TMP("NURE",$J,""))="" S NURFAC(2)=$S($G(NURFAC)=0:$G(NURFAC(1)),1:""),NURPROG(2)=$S($G(NURPROG)=0:$G(NURPROG(1)),1:"") D NHDR W !!,"THERE IS NO DATA FOR THIS REPORT" G QUIT^NURSEPCA
NPRINT S NURFAC(2)="" F S NURFAC(2)=$O(^TMP("NURE",$J,NURFAC(2))) Q:NURFAC(2)=""!(NUROUT) D NHDR Q:NUROUT D NO Q:NUROUT
Q
NO S NURPROG(2)="" F S NURPROG(2)=$O(^TMP("NURE",$J,NURFAC(2),NURPROG(2))) Q:NURPROG(2)="" S NDP="" F S NDP=$O(^TMP("NURE",$J,NURFAC(2),NURPROG(2),NDP)) Q:NDP=""!NUROUT D NR Q:NUROUT
Q
NR S N1="" F S N1=$O(^TMP("NURE",$J,NURFAC(2),NURPROG(2),NDP,N1)) Q:N1=""!NUROUT S NLDTPR=$E(NDP,1,7) D NS Q:NUROUT
Q
NS F NS1=0:0 S NS1=$O(^TMP("NURE",$J,NURFAC(2),NURPROG(2),NDP,N1,NS1)) Q:NS1'>0!NUROUT F DA=0:0 S DA=$O(^TMP("NURE",$J,NURFAC(2),NURPROG(2),NDP,N1,NS1,DA)) Q:DA'>0!NUROUT D NPPRINT W ! Q:NUROUT
Q
NPPRINT I 'NURSW1!($Y>(IOSL-5)) D NHDR Q:NUROUT
Q:'$D(^PRSE(452,NS1,0)) I HOLD W $E(N1,1,20)_" "_^TMP("NURE",$J,NURFAC(2),NURPROG(2),NDP,N1,NS1,DA) I 'NSP S HOLD=0
S:$D(NS1) ID=$P(^PRSE(452,NS1,0),"^")
D EN2^NURSUT0 S NLO=$S($D(NOD1):+$G(^NURSF(211.8,+NOD1,0)),1:"")
S NPWARD=NLO D EN7^NURSAUTL S NL1=NPWARD I HOLD(1) W ?25,$E(NL1,1,8) S:'NSP HOLD(1)=0
W:NDP'[" BLANK" ?35,$E(NDP,4,5),"/",$E(NDP,6,7),"/",$E(NDP,2,3)
I $D(^PRSE(452,NS1,0)),$P(^(0),U,2)'="" W ?45,$E($P(^(0),U,2),1,31)
I $P(^PRSE(452,NS1,0),U,15)'="" W ?78,$E($P(^(0),U,15),1,10)
I $P(^PRSE(452,NS1,0),"^",17)'="" W ?90,$P(^(0),"^",17)
I $P(^PRSE(452,NS1,0),"^",18)'="" W ?95,$P(^(0),"^",18)
K NFUND,NF3,NF4 S (NF3("TOTAL"),NF4("TOTAL"))=0 I $D(^PRSE(452,NS1,3,0)) F NS2=0:0 S NS2=$O(^PRSE(452,NS1,3,NS2)) Q:NS2'>0 D
. I $P($G(^PRSE(452,NS1,3,NS2,0)),U)'="" S X=$P(^(0),U),NFUND(X)=""
. S:$D(^PRSE(452,NS1,3,NS2,0)) NF3(X)=$P(^(0),"^",2),NF3("TOTAL")=NF3("TOTAL")+NF3(X)
. Q
I $D(^PRSE(452,NS1,4,0)) F NS2=0:0 S NS2=$O(^PRSE(452,NS1,4,NS2)) Q:NS2'>0 D
. I $D(^PRSE(452,NS1,4,NS2,0)),$P(^(0),"^",1)'="" S X=$P(^(0),"^",1),NFUND(X)=""
. S:$D(^PRSE(452,NS1,4,NS2,0)) NF4(X)=$P(^(0),"^",2),NF4("TOTAL")=NF4("TOTAL")+NF4(X)
. Q
I $D(NFUND) S N(1)=0 F N="A","P","R","H","T","N","U","B","D","I" Q:NUROUT I $D(NFUND(N)) D
. S X=$S(N="A":"AIRFA",N="P":"PER D",N="R":"REGIS",N="H":"HOTEL",N="T":"TRAVE",N="N":"NONE",N="U":"TUITI",N="B":"BOOKS",N="D":"DIREC",N="I":"INDIR",1:"")
. W:N(1)'=0 ! W:$D(NF3(N)) ?100,X,?107,$J(NF3(N),0,2) W:$D(NF4(N)) ?115,X,?123,$J(NF4(N),0,2)
. S N(1)=1 D:$Y>(IOSL-5) NHDR
. Q
I $D(^PRSE(452,NS1,5,0)) D
. I $Y>(IOSL-5) D NHDR Q:NUROUT
. W !,?37,"Comment: " S N(1)=0
. F NS2=0:0 S NS2=$O(^PRSE(452,NS1,5,NS2)) Q:NS2'>0!NUROUT I $L(^PRSE(452,NS1,5,NS2,0))>0 W:N(1)'=0 ! W ?47,^(0) S N(1)=1
. Q
S:$D(NF3("TOTAL")) NTOTAL3=NTOTAL3+NF3("TOTAL") S:$D(NF4("TOTAL")) NTOTAL4=NTOTAL4+NF4("TOTAL")
Q
NHDR ; HEADINGS ;Called by NURSEPCA
I NURSW1'="" I 'NURQUEUE,NURSW1 D ENDPG^NURSUT1 Q:$G(NUROUT)
S NURPAGE=NURPAGE+1 W:'($E(IOST)="P"&(NURPAGE=1)) @IOF
I NURMDSW,$G(NURFAC)'="" W !,?$$CNTR^NURSUT2(NURFAC(2)),$$FACL^NURSUT2(NURFAC(2))
W !,"AUTHORIZED ABSENCE AND FUNDING REQUESTS REPORT" S X="T" D ^%DT D:+Y D^DIQ W ?109,Y,?122,"PAGE: ",NURPAGE
W !!,"EMPLOYEE",?35,"CLASS",?78,"CLASS",?90,"AA",?95,"AA",?100,"FUNDS",?115,"FUNDS"
W !,"NAME",?25,"UNIT",?35,"DATE",?45,"CLASS",?78,"LOCATION",?90,"REQ",?95,"AUT",?100,"REQ",?107,"AMT",?115,"AUTH",?123,"AMT"
W !,$$REPEAT^XLFSTR("-",132)
I $G(NURPLSW),$G(NURPROG(2))'="" N Z S Z=$$PROD^NURSUT2(NURPROG(2)) W !,?$$CNTR^NURSUT2(NURPROG(2)),$G(Z),!,?$$CNTR^NURSUT2(NURPROG(2)),$$REPEAT^XLFSTR("-",$L(Z)+1)
W ! S (HOLD,HOLD(1),NURSW1)=1
Q
NURSEPC1 ;HIRMFO/MD,FT-AA/FUNDING REQUEST,PRINT (132 COLUMN REPORT) CON'T ;8/9/96 12:06
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; Called by NURSEPCA
+1 IF $ORDER(^TMP("NURE",$JOB,""))=""
SET NURFAC(2)=$SELECT($GET(NURFAC)=0:$GET(NURFAC(1)),1:"")
SET NURPROG(2)=$SELECT($GET(NURPROG)=0:$GET(NURPROG(1)),1:"")
DO NHDR
WRITE !!,"THERE IS NO DATA FOR THIS REPORT"
GOTO QUIT^NURSEPCA
NPRINT SET NURFAC(2)=""
FOR
SET NURFAC(2)=$ORDER(^TMP("NURE",$JOB,NURFAC(2)))
IF NURFAC(2)=""!(NUROUT)
QUIT
DO NHDR
IF NUROUT
QUIT
DO NO
IF NUROUT
QUIT
+1 QUIT
NO SET NURPROG(2)=""
FOR
SET NURPROG(2)=$ORDER(^TMP("NURE",$JOB,NURFAC(2),NURPROG(2)))
IF NURPROG(2)=""
QUIT
SET NDP=""
FOR
SET NDP=$ORDER(^TMP("NURE",$JOB,NURFAC(2),NURPROG(2),NDP))
IF NDP=""!NUROUT
QUIT
DO NR
IF NUROUT
QUIT
+1 QUIT
NR SET N1=""
FOR
SET N1=$ORDER(^TMP("NURE",$JOB,NURFAC(2),NURPROG(2),NDP,N1))
IF N1=""!NUROUT
QUIT
SET NLDTPR=$EXTRACT(NDP,1,7)
DO NS
IF NUROUT
QUIT
+1 QUIT
NS FOR NS1=0:0
SET NS1=$ORDER(^TMP("NURE",$JOB,NURFAC(2),NURPROG(2),NDP,N1,NS1))
IF NS1'>0!NUROUT
QUIT
FOR DA=0:0
SET DA=$ORDER(^TMP("NURE",$JOB,NURFAC(2),NURPROG(2),NDP,N1,NS1,DA))
IF DA'>0!NUROUT
QUIT
DO NPPRINT
WRITE !
IF NUROUT
QUIT
+1 QUIT
NPPRINT IF 'NURSW1!($Y>(IOSL-5))
DO NHDR
IF NUROUT
QUIT
+1 IF '$DATA(^PRSE(452,NS1,0))
QUIT
IF HOLD
WRITE $EXTRACT(N1,1,20)_" "_^TMP("NURE",$JOB,NURFAC(2),NURPROG(2),NDP,N1,NS1,DA)
IF 'NSP
SET HOLD=0
+2 IF $DATA(NS1)
SET ID=$PIECE(^PRSE(452,NS1,0),"^")
+3 DO EN2^NURSUT0
SET NLO=$SELECT($DATA(NOD1):+$GET(^NURSF(211.8,+NOD1,0)),1:"")
+4 SET NPWARD=NLO
DO EN7^NURSAUTL
SET NL1=NPWARD
IF HOLD(1)
WRITE ?25,$EXTRACT(NL1,1,8)
IF 'NSP
SET HOLD(1)=0
+5 IF NDP'[" BLANK"
WRITE ?35,$EXTRACT(NDP,4,5),"/",$EXTRACT(NDP,6,7),"/",$EXTRACT(NDP,2,3)
+6 IF $DATA(^PRSE(452,NS1,0))
IF $PIECE(^(0),U,2)'=""
WRITE ?45,$EXTRACT($PIECE(^(0),U,2),1,31)
+7 IF $PIECE(^PRSE(452,NS1,0),U,15)'=""
WRITE ?78,$EXTRACT($PIECE(^(0),U,15),1,10)
+8 IF $PIECE(^PRSE(452,NS1,0),"^",17)'=""
WRITE ?90,$PIECE(^(0),"^",17)
+9 IF $PIECE(^PRSE(452,NS1,0),"^",18)'=""
WRITE ?95,$PIECE(^(0),"^",18)
+10 KILL NFUND,NF3,NF4
SET (NF3("TOTAL"),NF4("TOTAL"))=0
IF $DATA(^PRSE(452,NS1,3,0))
FOR NS2=0:0
SET NS2=$ORDER(^PRSE(452,NS1,3,NS2))
IF NS2'>0
QUIT
Begin DoDot:1
+11 IF $PIECE($GET(^PRSE(452,NS1,3,NS2,0)),U)'=""
SET X=$PIECE(^(0),U)
SET NFUND(X)=""
+12 IF $DATA(^PRSE(452,NS1,3,NS2,0))
SET NF3(X)=$PIECE(^(0),"^",2)
SET NF3("TOTAL")=NF3("TOTAL")+NF3(X)
+13 QUIT
End DoDot:1
+14 IF $DATA(^PRSE(452,NS1,4,0))
FOR NS2=0:0
SET NS2=$ORDER(^PRSE(452,NS1,4,NS2))
IF NS2'>0
QUIT
Begin DoDot:1
+15 IF $DATA(^PRSE(452,NS1,4,NS2,0))
IF $PIECE(^(0),"^",1)'=""
SET X=$PIECE(^(0),"^",1)
SET NFUND(X)=""
+16 IF $DATA(^PRSE(452,NS1,4,NS2,0))
SET NF4(X)=$PIECE(^(0),"^",2)
SET NF4("TOTAL")=NF4("TOTAL")+NF4(X)
+17 QUIT
End DoDot:1
+18 IF $DATA(NFUND)
SET N(1)=0
FOR N="A","P","R","H","T","N","U","B","D","I"
IF NUROUT
QUIT
IF $DATA(NFUND(N))
Begin DoDot:1
+19 SET X=$SELECT(N="A":"AIRFA",N="P":"PER D",N="R":"REGIS",N="H":"HOTEL",N="T":"TRAVE",N="N":"NONE",N="U":"TUITI",N="B":"BOOKS",N="D":"DIREC",N="I":"INDIR",1:"")
+20 IF N(1)'=0
WRITE !
IF $DATA(NF3(N))
WRITE ?100,X,?107,$JUSTIFY(NF3(N),0,2)
IF $DATA(NF4(N))
WRITE ?115,X,?123,$JUSTIFY(NF4(N),0,2)
+21 SET N(1)=1
IF $Y>(IOSL-5)
DO NHDR
+22 QUIT
End DoDot:1
+23 IF $DATA(^PRSE(452,NS1,5,0))
Begin DoDot:1
+24 IF $Y>(IOSL-5)
DO NHDR
IF NUROUT
QUIT
+25 WRITE !,?37,"Comment: "
SET N(1)=0
+26 FOR NS2=0:0
SET NS2=$ORDER(^PRSE(452,NS1,5,NS2))
IF NS2'>0!NUROUT
QUIT
IF $LENGTH(^PRSE(452,NS1,5,NS2,0))>0
IF N(1)'=0
WRITE !
WRITE ?47,^(0)
SET N(1)=1
+27 QUIT
End DoDot:1
+28 IF $DATA(NF3("TOTAL"))
SET NTOTAL3=NTOTAL3+NF3("TOTAL")
IF $DATA(NF4("TOTAL"))
SET NTOTAL4=NTOTAL4+NF4("TOTAL")
+29 QUIT
NHDR ; HEADINGS ;Called by NURSEPCA
+1 IF NURSW1'=""
IF 'NURQUEUE
IF NURSW1
DO ENDPG^NURSUT1
IF $GET(NUROUT)
QUIT
+2 SET NURPAGE=NURPAGE+1
IF '($EXTRACT(IOST)="P"&(NURPAGE=1))
WRITE @IOF
+3 IF NURMDSW
IF $GET(NURFAC)'=""
WRITE !,?$$CNTR^NURSUT2(NURFAC(2)),$$FACL^NURSUT2(NURFAC(2))
+4 WRITE !,"AUTHORIZED ABSENCE AND FUNDING REQUESTS REPORT"
SET X="T"
DO ^%DT
IF +Y
DO D^DIQ
WRITE ?109,Y,?122,"PAGE: ",NURPAGE
+5 WRITE !!,"EMPLOYEE",?35,"CLASS",?78,"CLASS",?90,"AA",?95,"AA",?100,"FUNDS",?115,"FUNDS"
+6 WRITE !,"NAME",?25,"UNIT",?35,"DATE",?45,"CLASS",?78,"LOCATION",?90,"REQ",?95,"AUT",?100,"REQ",?107,"AMT",?115,"AUTH",?123,"AMT"
+7 WRITE !,$$REPEAT^XLFSTR("-",132)
+8 IF $GET(NURPLSW)
IF $GET(NURPROG(2))'=""
NEW Z
SET Z=$$PROD^NURSUT2(NURPROG(2))
WRITE !,?$$CNTR^NURSUT2(NURPROG(2)),$GET(Z),!,?$$CNTR^NURSUT2(NURPROG(2)),$$REPEAT^XLFSTR("-",$LENGTH(Z)+1)
+9 WRITE !
SET (HOLD,HOLD(1),NURSW1)=1
+10 QUIT
