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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAR1A 5513 printed Oct 16, 2024@18:20:25 Page 2
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
