- 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
