- NURSEPCA ;HIRMFO/PC,FT-AA/FUNDING REQUEST,PRINT (132 COLUMN REPORT) ;5/7/96 15:08
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EN1 S X=$G(^PRSE(452.7,1,"OFF")) Q:X=""!(X=1)
- S X=$G(^DIC(213.9,1,"OFF")) Q:X=""!(X=1)
- W ! S (NURQUEUE,NURSW1,NURPAGE,NUROUT)=0
- D EN1^NURSAUTL G QUIT:NUROUT D EN10^NURSUT3($G(DUZ)) I $G(NURSZAP)>7 S NDA=$O(^NURSF(210,"B",DUZ,0)) G DEV
- I NURMDSW S DIC(0)="AEQZ",NURPLSCR=0 D EN5^NURSAGSP G QUIT:$G(NUROUT)
- I NURMDSW=0,NURPLSW=1 S NURPLSCR=1 D PRD^NURSAGSP K NURPLSCR I $G(NUROUT) G QUIT
- ; DATE SELECTION
- D DATSEL^NURSAGP2 G:NUROUT QUIT
- K DIC S DIC("S")="I +$$EN6^NURSUT3($G(Y))"
- EN2 W ! S NSP=0,DIC("A")="Select Nursing Staff Name (Press return for "_$S(DUZ(0)["n"!(DUZ(0)["@"):"entire",1:"your assigned")_" nursing staff): ",DIC(0)="AEMQ",DIC="^NURSF(210," D ^DIC
- I '$D(DTOUT),(X="") S NSP=1 G DEV
- I +Y'>0!$D(DTOUT) S NUROUT=1 G QUIT
- S NDA=+$P($G(Y),U,2),NSPC=$S('$D(^VA(200,+$P($G(Y),U,2),0)):"",1:$P(^(0),"^",1))
- DEV W ! S ZTRTN="START^NURSEPCA",NURS132=1 D EN7^NURSUT0 K NURS132 G:POP!($D(ZTSK)) QUIT
- START ;
- K ^TMP("NURE",$J) S (HOLD,HOLD(1))=1,(NTOTAL3,NTOTAL4)=0
- I $G(NSP) F NDA=0:0 S NDA=$O(^NURSF(211.8,"C",NDA)) Q:NDA'>0 F NURNODE4=0:0 S NURNODE4=$O(^NURSF(211.8,"C",NDA,NURNODE4)) Q:NURNODE4'>0 D
- .F NURNODE5=0:0 S NURNODE5=$O(^NURSF(211.8,"C",NDA,NURNODE4,NURNODE5)) Q:NURNODE5'>0 I $D(^NURSF(211.8,NURNODE4,1,NURNODE5,0)),$P(^(0),U)'>DT&(('$P(^(0),U,6))!($P(^(0),U,6)'<DT)) D
- ..S DA=$O(^NURSF(210,"B",NDA,0)) I $P($G(^NURSF(210,+DA,0)),U,2)'="" W:$R(500)&($E(IOST)="C") "." D SORT
- ..Q
- .Q
- I '$G(NSP) S DA=$O(^NURSF(210,"B",+NDA,0)) D
- .F NURNODE4=0:0 S NURNODE4=$O(^NURSF(211.8,"C",NDA,NURNODE4)) Q:NURNODE4'>0 D
- ..F NURNODE5=0:0 S NURNODE5=$O(^NURSF(211.8,"C",NDA,NURNODE4,NURNODE5)) Q:NURNODE5'>0 I $D(^NURSF(211.8,NURNODE4,1,NURNODE5,0)),$P(^(0),U)'>DT&(('$P(^(0),U,6))!($P(^(0),U,6)'<DT)) D
- ..D SORT
- ..Q
- S X=$O(^TMP("NURE",$J,"")),NWRD("F")=$O(NURSNLOC(""))
- I X="" S NURSW1="",NURPAGE=0,NURFAC(2)=$S($G(NURFAC)=0:$G(NURFAC(1)),1:""),NURPROG=$S($G(NURPROG)=0:$G(NURPROG(1)),1:"") D NHDR^NURSEPC1 W !,"THERE IS NO DATA FOR "_$S($G(NURHOSP)=0&'$D(NURSNLOC)#2:$G(NWRD("F")),1:"THIS REPORT") G QUIT
- D EN1^NURSEPC1 I 'NUROUT D:$Y>(IOSL-5) NHDR^NURSEPC1 W:'NUROUT !!,"*** Total Funding Requested: ",$J(NTOTAL3,0,2),!,"*** Total Funding Authorized: ",$J(NTOTAL4,0,2),!
- QUIT K ^TMP("NURE",$J),N,NTOTAL3,NTOTAL4,NFUND D CLOSE^NURSUT1,^NURSKILL
- Q
- SORT ;
- Q:NDA'>0!(NURSZAP>7&(NURSZDA'=DA)) S NURSZORT=1 D EN3^NURSAUTL:NURSZAP>6,EN2^NURSAUTL:NURSZORT&NURSZAP Q:'NURSZORT
- W:$E(IOST)="C"&($R(5000)) "." I $D(^VA(200,NDA,0)),$P(^(0),"^",1)'="" S N1=$P(^(0),"^",1)
- E S N1=" BLANK"
- D EN2^NURSUT0 S SP=NPSPOS(1)
- S NURJ="" F S NURJ=$O(^PRSE(452,"AA","C",NDA,NURJ)) Q:NURJ="" F NDP=0:0 S NDP=$O(^PRSE(452,"AA","C",NDA,NURJ,NDP)) Q:NDP'>0 F NURI=0:0 S NURI=$O(^PRSE(452,"AA","C",NDA,NURJ,NDP,NURI)) Q:NURI'>0 D
- . S NURNEN=1 D SETPROG^NURAAGS1,SETFAC^NURAAGS1
- . I NURMDSW,'$G(NURFAC),$G(NURFAC(1))'=$G(NURFAC(2)) Q
- . I NURPLSW,'$G(NURPROG),$G(NURPROG(1))'=$G(NURPROG(2)) Q
- . S:NURPROG(2)="NURSING" NURPROG(2)=" "_NURPROG(2)
- . S NDP(1)=$P((9999999-NDP),U) I NDP(1)<YRST!(NDP(1)>YREND) Q
- . I 'NSP,N1'=NSPC Q
- . S ^TMP("NURE",$J,NURFAC(2),NURPROG(2),$E(NDP(1),1,7),N1,NURI,DA)=$$CAT^NURSUT2(SP)
- . Q
- Q
- NURSEPCA ;HIRMFO/PC,FT-AA/FUNDING REQUEST,PRINT (132 COLUMN REPORT) ;5/7/96 15:08
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EN1 SET X=$GET(^PRSE(452.7,1,"OFF"))
- IF X=""!(X=1)
- QUIT
- +1 SET X=$GET(^DIC(213.9,1,"OFF"))
- IF X=""!(X=1)
- QUIT
- +2 WRITE !
- SET (NURQUEUE,NURSW1,NURPAGE,NUROUT)=0
- +3 DO EN1^NURSAUTL
- IF NUROUT
- GOTO QUIT
- DO EN10^NURSUT3($GET(DUZ))
- IF $GET(NURSZAP)>7
- SET NDA=$ORDER(^NURSF(210,"B",DUZ,0))
- GOTO DEV
- +4 IF NURMDSW
- SET DIC(0)="AEQZ"
- SET NURPLSCR=0
- DO EN5^NURSAGSP
- IF $GET(NUROUT)
- GOTO QUIT
- +5 IF NURMDSW=0
- IF NURPLSW=1
- SET NURPLSCR=1
- DO PRD^NURSAGSP
- KILL NURPLSCR
- IF $GET(NUROUT)
- GOTO QUIT
- +6 ; DATE SELECTION
- +7 DO DATSEL^NURSAGP2
- IF NUROUT
- GOTO QUIT
- +8 KILL DIC
- SET DIC("S")="I +$$EN6^NURSUT3($G(Y))"
- EN2 WRITE !
- SET NSP=0
- SET DIC("A")="Select Nursing Staff Name (Press return for "_$SELECT(DUZ(0)["n"!(DUZ(0)["@"):"entire",1:"your assigned")_" nursing staff): "
- SET DIC(0)="AEMQ"
- SET DIC="^NURSF(210,"
- DO ^DIC
- +1 IF '$DATA(DTOUT)
- IF (X="")
- SET NSP=1
- GOTO DEV
- +2 IF +Y'>0!$DATA(DTOUT)
- SET NUROUT=1
- GOTO QUIT
- +3 SET NDA=+$PIECE($GET(Y),U,2)
- SET NSPC=$SELECT('$DATA(^VA(200,+$PIECE($GET(Y),U,2),0)):"",1:$PIECE(^(0),"^",1))
- DEV WRITE !
- SET ZTRTN="START^NURSEPCA"
- SET NURS132=1
- DO EN7^NURSUT0
- KILL NURS132
- IF POP!($DATA(ZTSK))
- GOTO QUIT
- START ;
- +1 KILL ^TMP("NURE",$JOB)
- SET (HOLD,HOLD(1))=1
- SET (NTOTAL3,NTOTAL4)=0
- +2 IF $GET(NSP)
- FOR NDA=0:0
- SET NDA=$ORDER(^NURSF(211.8,"C",NDA))
- IF NDA'>0
- QUIT
- FOR NURNODE4=0:0
- SET NURNODE4=$ORDER(^NURSF(211.8,"C",NDA,NURNODE4))
- IF NURNODE4'>0
- QUIT
- Begin DoDot:1
- +3 FOR NURNODE5=0:0
- SET NURNODE5=$ORDER(^NURSF(211.8,"C",NDA,NURNODE4,NURNODE5))
- IF NURNODE5'>0
- QUIT
- IF $DATA(^NURSF(211.8,NURNODE4,1,NURNODE5,0))
- IF $PIECE(^(0),U)'>DT&(('$PIECE(^(0),U,6))!($PIECE(^(0),U,6)'<DT))
- Begin DoDot:2
- +4 SET DA=$ORDER(^NURSF(210,"B",NDA,0))
- IF $PIECE($GET(^NURSF(210,+DA,0)),U,2)'=""
- IF $RANDOM(500)&($EXTRACT(IOST)="C")
- WRITE "."
- DO SORT
- +5 QUIT
- End DoDot:2
- +6 QUIT
- End DoDot:1
- +7 IF '$GET(NSP)
- SET DA=$ORDER(^NURSF(210,"B",+NDA,0))
- Begin DoDot:1
- +8 FOR NURNODE4=0:0
- SET NURNODE4=$ORDER(^NURSF(211.8,"C",NDA,NURNODE4))
- IF NURNODE4'>0
- QUIT
- Begin DoDot:2
- +9 FOR NURNODE5=0:0
- SET NURNODE5=$ORDER(^NURSF(211.8,"C",NDA,NURNODE4,NURNODE5))
- IF NURNODE5'>0
- QUIT
- IF $DATA(^NURSF(211.8,NURNODE4,1,NURNODE5,0))
- IF $PIECE(^(0),U)'>DT&(('$PIECE(^(0),U,6))!($PIECE(^(0),U,6)'<DT))
- Begin DoDot:3
- End DoDot:3
- +10 DO SORT
- +11 QUIT
- End DoDot:2
- End DoDot:1
- +12 SET X=$ORDER(^TMP("NURE",$JOB,""))
- SET NWRD("F")=$ORDER(NURSNLOC(""))
- +13 IF X=""
- SET NURSW1=""
- SET NURPAGE=0
- SET NURFAC(2)=$SELECT($GET(NURFAC)=0:$GET(NURFAC(1)),1:"")
- SET NURPROG=$SELECT($GET(NURPROG)=0:$GET(NURPROG(1)),1:"")
- DO NHDR^NURSEPC1
- WRITE !,"THERE IS NO DATA FOR "_$SELECT($GET(NURHOSP)=0&'$DATA(NURSNLOC)#2:$GET(NWRD("F")),1:"THIS REPORT")
- GOTO QUIT
- +14 DO EN1^NURSEPC1
- IF 'NUROUT
- IF $Y>(IOSL-5)
- DO NHDR^NURSEPC1
- IF 'NUROUT
- WRITE !!,"*** Total Funding Requested: ",$JUSTIFY(NTOTAL3,0,2),!,"*** Total Funding Authorized: ",$JUSTIFY(NTOTAL4,0,2),!
- QUIT KILL ^TMP("NURE",$JOB),N,NTOTAL3,NTOTAL4,NFUND
- DO CLOSE^NURSUT1
- DO ^NURSKILL
- +1 QUIT
- SORT ;
- +1 IF NDA'>0!(NURSZAP>7&(NURSZDA'=DA))
- QUIT
- SET NURSZORT=1
- IF NURSZAP>6
- DO EN3^NURSAUTL
- IF NURSZORT&NURSZAP
- DO EN2^NURSAUTL
- IF 'NURSZORT
- QUIT
- +2 IF $EXTRACT(IOST)="C"&($RANDOM(5000))
- WRITE "."
- IF $DATA(^VA(200,NDA,0))
- IF $PIECE(^(0),"^",1)'=""
- SET N1=$PIECE(^(0),"^",1)
- +3 IF '$TEST
- SET N1=" BLANK"
- +4 DO EN2^NURSUT0
- SET SP=NPSPOS(1)
- +5 SET NURJ=""
- FOR
- SET NURJ=$ORDER(^PRSE(452,"AA","C",NDA,NURJ))
- IF NURJ=""
- QUIT
- FOR NDP=0:0
- SET NDP=$ORDER(^PRSE(452,"AA","C",NDA,NURJ,NDP))
- IF NDP'>0
- QUIT
- FOR NURI=0:0
- SET NURI=$ORDER(^PRSE(452,"AA","C",NDA,NURJ,NDP,NURI))
- IF NURI'>0
- QUIT
- Begin DoDot:1
- +6 SET NURNEN=1
- DO SETPROG^NURAAGS1
- DO SETFAC^NURAAGS1
- +7 IF NURMDSW
- IF '$GET(NURFAC)
- IF $GET(NURFAC(1))'=$GET(NURFAC(2))
- QUIT
- +8 IF NURPLSW
- IF '$GET(NURPROG)
- IF $GET(NURPROG(1))'=$GET(NURPROG(2))
- QUIT
- +9 IF NURPROG(2)="NURSING"
- SET NURPROG(2)=" "_NURPROG(2)
- +10 SET NDP(1)=$PIECE((9999999-NDP),U)
- IF NDP(1)<YRST!(NDP(1)>YREND)
- QUIT
- +11 IF 'NSP
- IF N1'=NSPC
- QUIT
- +12 SET ^TMP("NURE",$JOB,NURFAC(2),NURPROG(2),$EXTRACT(NDP(1),1,7),N1,NURI,DA)=$$CAT^NURSUT2(SP)
- +13 QUIT
- End DoDot:1
- +14 QUIT
