- NURAR1A ;HIRMFO/MD,FT-ACCUMULATES FTEE TOTALS AND RUNS SVC. AMIS 1106b REPORT ;9/18/96 16:57
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- HSKEEP ;
- S X=$G(^DIC(213.9,1,"OFF")) Q:X=""!(X=1)
- S (NODATSW,NUROUT,NURQUEUE,NURMDSW,NURSW1,NURPAGE)=0
- D EN9^NURSAGSP I NURMDSW W ! S DIC(0)="AEMQZ" D EN8^NURSAGSP G QUIT:NUROUT
- I 'NURMDSW S NDA=1,NURFAC=+$G(^NURSA(213.2,NDA,0)),NURFAC("F")=$$GET1^DIQ(4,+NURFAC,.01,"I") D NEXT
- I NURMDSW,$G(NURFAC)=1 S NDA=0 F S NDA=$O(^NURSA(213.2,NDA)) Q:NDA'>0 S NURFAC("F")=$$GET1^DIQ(4,+$G(^NURSA(213.2,NDA,0)),.01,"I") D NEXT
- I NURMDSW,$G(NURFAC)=0 S NDA=+Y,NURFAC("F")=$$GET1^DIQ(4,+$G(^NURSA(213.2,NDA,0)),.01,"I") D NEXT
- I $G(NURFACSW)=1 S NURFAC=0 ;switch NURFAC to 0, not all divisions have data
- W !!,?19,"THIS REPORT WILL COMPARE THE BUDGETED FTEE"
- W !,?14,"TOTALS ENTERED IN THE NURS AMIS 1106B FTEE (#213.2) FILE"
- W !,?10,"AGAINST TODAY'S CURRENT FTEE ENTRIES FOR AMIS SEGMENT 202 (1106B)"
- ; QUEUE JOB TO TASKMAN
- W ! S (ZTSAVE("NURSW1"),ZTSAVE("NURPAGE"),ZTSAVE("NURFAC*"))="",ZTRTN="START^NURAR1A" D EN7^NURSUT0 G:POP!($D(ZTSK)) QUIT
- START ;
- S DA(2)=0 F S DA(2)=$O(^NURSF(211.8,"C",DA(2))) Q:DA(2)'>0 D
- . S Z=0,Z=$O(^NURSF(210,"B",DA(2),0)) Q:Z="" D:$P($G(^NURSF(210,Z,0)),U,2)="A"
- . . S DA(1)=0 F S DA(1)=$O(^NURSF(211.8,"C",DA(2),DA(1))) Q:DA(1)'>0 S DA=0 F S DA=$O(^NURSF(211.8,"C",DA(2),DA(1),DA)) Q:DA'>0 D
- . . . S DA(4)=$P($G(^NURSF(211.8,DA(1),0)),U) Q:DA(4)'>0 I $D(^NURSF(211.4,"B",DA(4))) S DA(5)=0,DA(5)=$O(^NURSF(211.4,"B",DA(4),0)) I $S('$D(^NURSF(211.4,DA(5),"I")):1,$P(^("I"),U)="A":1,1:0) D
- . . . . W:$E(IOST)="C"&($R(500)) "." S NDATA=$G(^NURSF(211.8,DA(1),1,DA,0)) S NDATA(1)=$S($$EN11^NURSUT3(DA(1))'="":$$EN11^NURSUT3(DA(1)),1:" BLANK")
- . . . . I $S('+$P(NDATA,U,4):1,+$P(NDATA,U)>DT:1,+$P(NDATA,U,6)&(+$P(NDATA,U,6)<DT):1,1:0) Q
- . . . . I NURMDSW,$G(NURFAC)=0,$G(NDATA(1))'=" BLANK",$G(NDATA(1))'=$G(NURFAC(1)) Q
- . . . . I 'NURMDSW,$G(NDATA(1))'=$G(NURFAC("F")) Q
- . . . . S NFTEE=+$P(NDATA,U,4),NURSCAT=$S($D(^NURSF(211.3,+$P(NDATA,U,3),0)):$P(^(0),U,5),1:""),NAMIS=$S($D(^NURSF(211.3,+$P(NDATA,U,3),0)):+$P(^(0),U,4),1:0)
- . . . . I '+NAMIS,NURSCAT="R",$D(^NURSF(211.3,+$P(NDATA,U,3),0)) W !,"THE AMIS POSITION FIELD FOR THE "_$P(^(0),U)_" ENTRY IN THE NURS SERVICE POSITION FILE,",!,"#211.3 MUST BE FILLED IN TO GENERATE THIS REPORT",! S NUROUT=1 Q
- . . . . S NURSCAT(1)=$S(NURSCAT="R":1,NURSCAT="L":2,NURSCAT="N":3,NURSCAT="C":4,NURSCAT="A":5,1:0)
- . . . . I NURSCAT="R" D
- . . . . . I NDATA(1)'=" BLANK" S NFCNT(NDATA(1),NAMIS)=NFCNT(NDATA(1),NAMIS)+NFTEE
- . . . . . E S:'$D(NFCNT(" BLANK",NAMIS)) NFCNT(" BLANK",NAMIS)=0 S NFCNT(" BLANK",NAMIS)=NFCNT(" BLANK",NAMIS)+NFTEE
- . . . . . Q
- . . . . I NDATA(1)'=" BLANK",+NURSCAT(1) S NFCNT(NDATA(1),NURSCAT(1))=NFCNT(NDATA(1),NURSCAT(1))+NFTEE
- . . . . I NDATA(1)=" BLANK",+NURSCAT S:'$D(NFCNT(" BLANK",NURSACT(1))) NFCNT(" BLANK",NURSCAT(1))=0 S NFCNT(" BLANK",NURSCAT(1))=NFCNT(" BLANK",NURSCAT(1))+NFTEE
- . . . . Q
- . . . Q
- . . Q
- . Q
- U IO S NY="" F S NY=$O(NFCNT(NY)) Q:NY="" D HEADER Q:NUROUT D Q:NUROUT
- . S NDA=$P($G(NFCNT(NY,"DATE")),U,2) S NZ=0 F S NZ=$O(^DD(213.2,NZ)) Q:NZ'>0!NUROUT S X=$$VFIELD^DILFD(213.2,NZ) I NZ'<1,NZ'>20,X D Q:NUROUT
- . . I 'NURSW1!($E(IOST)="C"&($Y>(IOSL-5))) D HEADER Q:NUROUT
- . . S ND=$S(NZ<17:0,1:.5),ND(1)=$S(NZ<17:$P($G(^NURSA(213.2,+NDA,ND)),U,NZ+1),1:$P($G(^NURSA(213.2,+NDA,ND)),U,NZ-16)) D FIELD^DID(213.2,NZ,"","LABEL","X"),FIELD^DID(213.2,NZ+20,"","LABEL","Y")
- . . I $D(NFCNT(NY,NZ)) D
- . . . W !,$P(X("LABEL"),"BUDGETED ",2),?24,$P(X("LABEL")," "),?29,$J(ND(1),8,3),?43,$P(Y("LABEL")," "),?48,$J(NFCNT(NY,NZ),8,3)
- . . . W ?65,$J((NFCNT(NY,NZ)-ND(1)),9,3)
- . . . Q
- . . Q
- . Q
- QUIT ;
- D CLOSE^NURSUT1,^NURAKILL
- Q
- S NURPAGE=NURPAGE+1,Y=+$G(NFCNT(NY,"DATE")) D:+Y D^DIQ S NURSDATE=Y I $E(IOST)="C"!(NURPAGE>1) W @IOF
- W ! S X="T" D ^%DT D:+Y D^DIQ W ?2,Y,?65,"PAGE: ",NURPAGE
- W ! I NURMDSW W ?$$CNTR^NURSUT2(NY),$S(NY=" BLANK":"NO FACILITY",1:NY)
- W !,?2,"AMIS 10-1106B (SEGMENT 202) CEILING (FTEE) ENTERED ON "_NURSDATE
- W !,?2,"AND POSITIONS FILLED (FTEE)"
- W !!,"POSITION",?29,"BUDGETED",?50,"ACTUAL",?66,"VARIANCE"
- W !,"--------",?29,"--------",?50,"------",?66,"--------"
- S NURSW1=1
- Q
- NEXT ;
- S NODATSW=0
- I '$D(^NURSA(213.2,NDA,0))!('$D(^NURSA(213.2,NDA,1)))!('$D(^NURSA(213.2,NDA,.5))) S NODATSW=1
- I NODATSW=0 S:$P(^NURSA(213.2,NDA,1),U,11)="" NODATSW=1 F NURI=1:1:17 S:$P(^NURSA(213.2,NDA,0),U,NURI)="" NODATSW=1
- I NODATSW=0 F NURI=1:1:4 S:$P(^NURSA(213.2,NDA,.5),U,NURI)="" NODATSW=1
- I NODATSW=1 D Q
- .W !!,$C(7),"*** YOU ARE MISSING DATA IN THE "_NURFAC("F"),!," AMIS 1106B FTEE (213.2) FILE ENTRY.",!," CONTACT THE NURSING APPLICATION COORDINATOR.",!
- .S:(NURMDSW&($G(NURFAC)=1)) NURFACSW=1 ;set flag to change NURFAC from 1 to 0
- .Q
- I NURMDSW,'$G(NURFAC),NURFAC("F")'=NURFAC(1) Q
- F NURI=1:1:20 S NFCNT(NURFAC("F"),NURI)=0
- S:'+$G(NFCNT(NURFAC("F"),"DATE")) NFCNT(NURFAC("F"),"DATE")=$P(^NURSA(213.2,NDA,1),U,11)_U_NDA
- S NBUDCK=$P(^NURSA(213.2,NDA,0),U,2)
- S NBUDCK1=0
- F NURI=7:1:17 S NBUDCK1=NBUDCK1+$P(^NURSA(213.2,NDA,0),U,NURI)
- F NURI=1:1:4 S NBUDCK1=NBUDCK1+$P(^NURSA(213.2,NDA,.5),U,NURI)
- I NBUDCK'=NBUDCK1 W !!!,"INCORRECT BUDGET ENTRIES EXIST IN "_NURFAC("F")_":",!,"NUMBER OF RN'S BUDGETED MUST EQUAL SUM OF",!,"CATEGORIES 06 THRU 20 (E.G. CLIN SPECIALIST, RN PRACTITIONER, ETC.",!,"CONTACT NURSING APPLICATION COORDINATOR" Q
- Q
- NURAR1A ;HIRMFO/MD,FT-ACCUMULATES FTEE TOTALS AND RUNS SVC. AMIS 1106b REPORT ;9/18/96 16:57
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- HSKEEP ;
- +1 SET X=$GET(^DIC(213.9,1,"OFF"))
- IF X=""!(X=1)
- QUIT
- +2 SET (NODATSW,NUROUT,NURQUEUE,NURMDSW,NURSW1,NURPAGE)=0
- +3 DO EN9^NURSAGSP
- IF NURMDSW
- WRITE !
- SET DIC(0)="AEMQZ"
- DO EN8^NURSAGSP
- IF NUROUT
- GOTO QUIT
- +4 IF 'NURMDSW
- SET NDA=1
- SET NURFAC=+$GET(^NURSA(213.2,NDA,0))
- SET NURFAC("F")=$$GET1^DIQ(4,+NURFAC,.01,"I")
- DO NEXT
- +5 IF NURMDSW
- IF $GET(NURFAC)=1
- SET NDA=0
- FOR
- SET NDA=$ORDER(^NURSA(213.2,NDA))
- IF NDA'>0
- QUIT
- SET NURFAC("F")=$$GET1^DIQ(4,+$GET(^NURSA(213.2,NDA,0)),.01,"I")
- DO NEXT
- +6 IF NURMDSW
- IF $GET(NURFAC)=0
- SET NDA=+Y
- SET NURFAC("F")=$$GET1^DIQ(4,+$GET(^NURSA(213.2,NDA,0)),.01,"I")
- DO NEXT
- +7 ;switch NURFAC to 0, not all divisions have data
- IF $GET(NURFACSW)=1
- SET NURFAC=0
- +8 WRITE !!,?19,"THIS REPORT WILL COMPARE THE BUDGETED FTEE"
- +9 WRITE !,?14,"TOTALS ENTERED IN THE NURS AMIS 1106B FTEE (#213.2) FILE"
- +10 WRITE !,?10,"AGAINST TODAY'S CURRENT FTEE ENTRIES FOR AMIS SEGMENT 202 (1106B)"
- +11 ; QUEUE JOB TO TASKMAN
- +12 WRITE !
- SET (ZTSAVE("NURSW1"),ZTSAVE("NURPAGE"),ZTSAVE("NURFAC*"))=""
- SET ZTRTN="START^NURAR1A"
- DO EN7^NURSUT0
- IF POP!($DATA(ZTSK))
- GOTO QUIT
- START ;
- +1 SET DA(2)=0
- FOR
- SET DA(2)=$ORDER(^NURSF(211.8,"C",DA(2)))
- IF DA(2)'>0
- QUIT
- Begin DoDot:1
- +2 SET Z=0
- SET Z=$ORDER(^NURSF(210,"B",DA(2),0))
- IF Z=""
- QUIT
- IF $PIECE($GET(^NURSF(210,Z,0)),U,2)="A"
- Begin DoDot:2
- +3 SET DA(1)=0
- FOR
- SET DA(1)=$ORDER(^NURSF(211.8,"C",DA(2),DA(1)))
- IF DA(1)'>0
- QUIT
- SET DA=0
- FOR
- SET DA=$ORDER(^NURSF(211.8,"C",DA(2),DA(1),DA))
- IF DA'>0
- QUIT
- Begin DoDot:3
- +4 SET DA(4)=$PIECE($GET(^NURSF(211.8,DA(1),0)),U)
- IF DA(4)'>0
- QUIT
- IF $DATA(^NURSF(211.4,"B",DA(4)))
- SET DA(5)=0
- SET DA(5)=$ORDER(^NURSF(211.4,"B",DA(4),0))
- IF $SELECT('$DATA(^NURSF(211.4,DA(5),"I")):1,$PIECE(^("I"),U)="A":1,1:0)
- Begin DoDot:4
- +5 IF $EXTRACT(IOST)="C"&($RANDOM(500))
- WRITE "."
- SET NDATA=$GET(^NURSF(211.8,DA(1),1,DA,0))
- SET NDATA(1)=$SELECT($$EN11^NURSUT3(DA(1))'="":$$EN11^NURSUT3(DA(1)),1:" BLANK")
- +6 IF $SELECT('+$PIECE(NDATA,U,4):1,+$PIECE(NDATA,U)>DT:1,+$PIECE(NDATA,U,6)&(+$PIECE(NDATA,U,6)<DT):1,1:0)
- QUIT
- +7 IF NURMDSW
- IF $GET(NURFAC)=0
- IF $GET(NDATA(1))'=" BLANK"
- IF $GET(NDATA(1))'=$GET(NURFAC(1))
- QUIT
- +8 IF 'NURMDSW
- IF $GET(NDATA(1))'=$GET(NURFAC("F"))
- QUIT
- +9 SET NFTEE=+$PIECE(NDATA,U,4)
- SET NURSCAT=$SELECT($DATA(^NURSF(211.3,+$PIECE(NDATA,U,3),0)):$PIECE(^(0),U,5),1:"")
- SET NAMIS=$SELECT($DATA(^NURSF(211.3,+$PIECE(NDATA,U,3),0)):+$PIECE(^(0),U,4),1:0)
- +10 IF '+NAMIS
- IF NURSCAT="R"
- IF $DATA(^NURSF(211.3,+$PIECE(NDATA,U,3),0))
- WRITE !,"THE AMIS POSITION FIELD FOR THE "_$PIECE(^(0),U)_" ENTRY IN THE NURS SERVICE POSITION FILE,",!,"#211.3 MUST BE FILLED IN TO GENERATE THIS REPORT",!
- SET NUROUT=1
- QUIT
- +11 SET NURSCAT(1)=$SELECT(NURSCAT="R":1,NURSCAT="L":2,NURSCAT="N":3,NURSCAT="C":4,NURSCAT="A":5,1:0)
- +12 IF NURSCAT="R"
- Begin DoDot:5
- +13 IF NDATA(1)'=" BLANK"
- SET NFCNT(NDATA(1),NAMIS)=NFCNT(NDATA(1),NAMIS)+NFTEE
- +14 IF '$TEST
- IF '$DATA(NFCNT(" BLANK",NAMIS))
- SET NFCNT(" BLANK",NAMIS)=0
- SET NFCNT(" BLANK",NAMIS)=NFCNT(" BLANK",NAMIS)+NFTEE
- +15 QUIT
- End DoDot:5
- +16 IF NDATA(1)'=" BLANK"
- IF +NURSCAT(1)
- SET NFCNT(NDATA(1),NURSCAT(1))=NFCNT(NDATA(1),NURSCAT(1))+NFTEE
- +17 IF NDATA(1)=" BLANK"
- IF +NURSCAT
- IF '$DATA(NFCNT(" BLANK",NURSACT(1)))
- SET NFCNT(" BLANK",NURSCAT(1))=0
- SET NFCNT(" BLANK",NURSCAT(1))=NFCNT(" BLANK",NURSCAT(1))+NFTEE
- +18 QUIT
- End DoDot:4
- +19 QUIT
- End DoDot:3
- +20 QUIT
- End DoDot:2
- +21 QUIT
- End DoDot:1
- +22 USE IO
- SET NY=""
- FOR
- SET NY=$ORDER(NFCNT(NY))
- IF NY=""
- QUIT
- DO HEADER
- IF NUROUT
- QUIT
- Begin DoDot:1
- +23 SET NDA=$PIECE($GET(NFCNT(NY,"DATE")),U,2)
- SET NZ=0
- FOR
- SET NZ=$ORDER(^DD(213.2,NZ))
- IF NZ'>0!NUROUT
- QUIT
- SET X=$$VFIELD^DILFD(213.2,NZ)
- IF NZ'<1
- IF NZ'>20
- IF X
- Begin DoDot:2
- +24 IF 'NURSW1!($EXTRACT(IOST)="C"&($Y>(IOSL-5)))
- DO HEADER
- IF NUROUT
- QUIT
- +25 SET ND=$SELECT(NZ<17:0,1:.5)
- SET ND(1)=$SELECT(NZ<17:$PIECE($GET(^NURSA(213.2,+NDA,ND)),U,NZ+1),1:$PIECE($GET(^NURSA(213.2,+NDA,ND)),U,NZ-16))
- DO FIELD^DID(213.2,NZ,"","LABEL","X")
- DO FIELD^DID(213.2,NZ+20,"","LABEL","Y")
- +26 IF $DATA(NFCNT(NY,NZ))
- Begin DoDot:3
- +27 WRITE !,$PIECE(X("LABEL"),"BUDGETED ",2),?24,$PIECE(X("LABEL")," "),?29,$JUSTIFY(ND(1),8,3),?43,$PIECE(Y("LABEL")," "),?48,$JUSTIFY(NFCNT(NY,NZ),8,3)
- +28 WRITE ?65,$JUSTIFY((NFCNT(NY,NZ)-ND(1)),9,3)
- +29 QUIT
- End DoDot:3
- +30 QUIT
- End DoDot:2
- IF NUROUT
- QUIT
- +31 QUIT
- End DoDot:1
- IF NUROUT
- QUIT
- QUIT ;
- +1 DO CLOSE^NURSUT1
- DO ^NURAKILL
- +2 QUIT
- IF $EXTRACT(IOST)="C"
- WRITE !
- DO ENDPG^NURSUT1
- IF NUROUT
- QUIT
- +1 SET NURPAGE=NURPAGE+1
- SET Y=+$GET(NFCNT(NY,"DATE"))
- IF +Y
- DO D^DIQ
- SET NURSDATE=Y
- IF $EXTRACT(IOST)="C"!(NURPAGE>1)
- WRITE @IOF
- +2 WRITE !
- SET X="T"
- DO ^%DT
- IF +Y
- DO D^DIQ
- WRITE ?2,Y,?65,"PAGE: ",NURPAGE
- +3 WRITE !
- IF NURMDSW
- WRITE ?$$CNTR^NURSUT2(NY),$SELECT(NY=" BLANK":"NO FACILITY",1:NY)
- +4 WRITE !,?2,"AMIS 10-1106B (SEGMENT 202) CEILING (FTEE) ENTERED ON "_NURSDATE
- +5 WRITE !,?2,"AND POSITIONS FILLED (FTEE)"
- +6 WRITE !!,"POSITION",?29,"BUDGETED",?50,"ACTUAL",?66,"VARIANCE"
- +7 WRITE !,"--------",?29,"--------",?50,"------",?66,"--------"
- +8 SET NURSW1=1
- +9 QUIT
- NEXT ;
- +1 SET NODATSW=0
- +2 IF '$DATA(^NURSA(213.2,NDA,0))!('$DATA(^NURSA(213.2,NDA,1)))!('$DATA(^NURSA(213.2,NDA,.5)))
- SET NODATSW=1
- +3 IF NODATSW=0
- IF $PIECE(^NURSA(213.2,NDA,1),U,11)=""
- SET NODATSW=1
- FOR NURI=1:1:17
- IF $PIECE(^NURSA(213.2,NDA,0),U,NURI)=""
- SET NODATSW=1
- +4 IF NODATSW=0
- FOR NURI=1:1:4
- IF $PIECE(^NURSA(213.2,NDA,.5),U,NURI)=""
- SET NODATSW=1
- +5 IF NODATSW=1
- Begin DoDot:1
- +6 WRITE !!,$CHAR(7),"*** YOU ARE MISSING DATA IN THE "_NURFAC("F"),!," AMIS 1106B FTEE (213.2) FILE ENTRY.",!," CONTACT THE NURSING APPLICATION COORDINATOR.",!
- +7 ;set flag to change NURFAC from 1 to 0
- IF (NURMDSW&($GET(NURFAC)=1))
- SET NURFACSW=1
- +8 QUIT
- End DoDot:1
- QUIT
- +9 IF NURMDSW
- IF '$GET(NURFAC)
- IF NURFAC("F")'=NURFAC(1)
- QUIT
- +10 FOR NURI=1:1:20
- SET NFCNT(NURFAC("F"),NURI)=0
- +11 IF '+$GET(NFCNT(NURFAC("F"),"DATE"))
- SET NFCNT(NURFAC("F"),"DATE")=$PIECE(^NURSA(213.2,NDA,1),U,11)_U_NDA
- +12 SET NBUDCK=$PIECE(^NURSA(213.2,NDA,0),U,2)
- +13 SET NBUDCK1=0
- +14 FOR NURI=7:1:17
- SET NBUDCK1=NBUDCK1+$PIECE(^NURSA(213.2,NDA,0),U,NURI)
- +15 FOR NURI=1:1:4
- SET NBUDCK1=NBUDCK1+$PIECE(^NURSA(213.2,NDA,.5),U,NURI)
- +16 IF NBUDCK'=NBUDCK1
- WRITE !!!,"INCORRECT BUDGET ENTRIES EXIST IN "_NURFAC("F")_":",!,"NUMBER OF RN'S BUDGETED MUST EQUAL SUM OF",!,"CATEGORIES 06 THRU 20 (E.G. CLIN SPECIALIST, RN PRACTITIONER, ETC.",!,"CONTACT NURSING APPLICATION COORDINATOR"
- QUIT
- +17 QUIT
