- NURAED1 ;HIRMFO/MD,RM-EDIT FOR POSITION ;8/19/97
- ;;4.0;NURSING SERVICE;**3,12**;Apr 25, 1997
- S NUROUT=0,NID=$S($D(^NURSF(210,+NURSDBA,0)):$P(^(0),U),1:"") D STST^NURAED4 G QB:$G(NUROUT)
- SELECT K NURSUL,NURSASS D WRITE
- NOPOS I '$O(NURSASS("")) S NURAES="N" W !!,"THERE ARE NO ",$S(NURLS="P":"PAST ",NURLS="C":"CURRENT ",1:""),"EMPLOYEE ASSIGNMENTS " W:NURLS="P" "AFTER SELECTED DATE"
- NOPOS1 I '$O(NURSASS("")),NURLS="P" S %=1 W !!,"Would you like to see this employee's current position(s)" D YN^DICN W:%=0 !,$C(7),"Answer 'YES' or 'NO'" G:%=0 NOPOS Q:%'>0!(%=2) S NURLS="C" D WRITE G NOPOS
- I $O(NURSASS("")) D WRT1 W !!,"Enter selection or type ? for help: " R NURAES:DTIME S NURAES=$S(NURAES="n":"N",1:NURAES) S:NURAES=U!(NURAES="^^")!'$T NUROUT=1 G:$G(NUROUT)!(NURAES="") QB
- I NURLS="P",NURAES="N" W $C(7),!!,"NEW ASSIGNMENTS MUST BE ADDED FROM THE CURRENT DISPLAY SCREEN" G SELECT
- W ! S NURSBAD=0 D VALSEL^NURAED2 I NURSBAD D MORHELP^NURAED4 G QB:$G(NUROUT),SELECT
- D EN1^NURAED2 G QB:$G(NUROUT),SELECT:$D(MSG)
- S NUR("CNTR")=0 F NURSANM=0:0 S NURSANM=$O(NURSASS(NURSANM)) Q:NURSANM'>0 D VALE0^NURAED2
- D VALENT^NURAED2 I $G(NUROUT) S NUROUT=0 G SELECT
- D EN1^NURAED6 G:'$G(NUROUT)&$O(NURSASS("")) SELECT
- QB K %,NURCAT,NL1,X,Y,Z,MSG,NURSUL,NUR1,NUR2,NUR3,NURAES,NURAS,NUR10,NURSBAD,NX,NURY,NWARD
- QC ; KILL VARIABLES
- K NURSW1,NID,NCNT,NURSASS,NDA,I,J,NPSPOS,NURTFTEE,NPWARD,NDATA,NURSANM,NOD,NURST,NURSTDT,DA,NURLS,NURSNPOS,NURSOPOS,NURSPOS,NURSX,NZ,NOD1,NOD2,NURSDFLT,NURFLAG
- Q
- S IOP=ION D ^%ZIS K IOP D EN2^NURSUT0 S NNM=$S($D(^VA(200,$P(^NURSF(210,+NURSDBA,0),U),0)):$P(^(0),U),1:+NURSDBA),NSSN=$S($D(^VA(200,$P(^NURSF(210,+NURSDBA,0),U),1)):$P(^(1),U,9),1:"")
- I $D(^VA(200,$P(^NURSF(210,+NURSDBA,0),U),0)) W @IOF,!!,?25,"EMPLOYEE: ",$P(^VA(200,$P(^NURSF(210,+NURSDBA,0),U),0),U) W:$D(NPSPOS) ?$X+2,NPSPOS W !,?25,"SSN: ",NSSN,!!
- K NPTR,NNM,NPSPOS,NSSN
- Q
- WRITE ; CALL TO DISPLAY THE POSITIONS FOR THIS STAFF MEMBER
- ; +NURSDBA=210 FILE ENTRY, NURSTDT=DATE FOR WHICH LISTING BEGINS
- K NURAS,NURASS S NURSW1=1,NCNT=0
- F NOD=0:0 S NOD=$O(^NURSF(211.8,"C",+NID,NOD)) Q:NOD'>0 F NDA=0:0 S NDA=$O(^NURSF(211.8,"C",+NID,NOD,NDA)) Q:NDA'>0 I $D(^NURSF(211.8,NOD,1,NDA,0)) S NDATA=^(0) D CKASN
- F I=-1:0 S I=$O(NURAS(I)) Q:I'>0 F J=-1:0 S J=$O(NURAS(I,J)) Q:J'>0 F NOD=0:0 S NOD=$O(NURAS(I,J,NOD)) Q:NOD'>0 F NDA=0:0 S NDA=$O(NURAS(I,J,NOD,NDA)) Q:NDA'>0 D SETARY
- Q
- WRT1 ; POSITION DISPLAY
- F NURSANM=0:0 S NURSANM=$O(NURSASS(NURSANM)) Q:NURSANM'>0 D DISPLAY
- Q:'$O(NURSASS(""))
- W !!?24,"STATUS: ",$S($P(^NURSF(210,+NURSDBA,0),U,2)="A":"ACTIVE",$P(^(0),U,2)="I":"INTERMITTENT",1:"INACTIVE")
- S DA=+NURSDBA K NPSPOS D EN2^NURSUT0
- I $G(NPSPOS)'="" W !?6,"PRIMARY SERVICE POSITION: ",$E($P(^NURSF(211.3,NPSPOS(0),0),U,2),1,24)
- I NURPLSW,$G(NPSPOS(2))'="" W !,"PRIMARY SVC. POS. PRODUCT LINE: ",NPSPOS(2)
- I NURPLSW,$G(NPSPOS(4))'="" W !?1,"PRIMARY LOCATION PRODUCT LINE: ",NPSPOS(4)
- I $P($G(^DIC(213.9,1,0)),U,9)="Y" W !?14,"PRIMARY FACILITY: ",$G(NPSPOS(3))
- I $D(^NURSF(211.8,"C",+NID)) S NUR("DA")=+NURSDBA D EN1^NURSUT2 W:+NURTFTEE&("C"[NURLS) !,?9,"TOTAL ASSIGNMENT FTEE: ",$J(NURTFTEE,2,3)
- E W !
- K NURAS Q
- DISPLAY ; DATA DISPLAY
- S (NURPLSW,NURMDSW)=0 D EN9^NURSAGSP S NDATA=$P(NURSASS(NURSANM),U,5,14)
- I NURSW1 W !!,"LOCATION"_$S($G(NURPLSW):"/",1:""),?16,"POSITION"_$S($G(NURPLSW):"/",1:""),?33,"DUTY",?49,"START",?59,"VACANCY",?70,"FTEE"
- I NURSW1 W ! W:NURPLSW "PRODUCT LINE" W:NURPLSW ?16,"PRODUCT LINE" W ?33,"TOUR",?49,"DATE",?59,"DATE",! S Z="",$P(Z,"-",80)="" W Z S NURSW1=0
- W !,NURSANM,$S($P(NDATA,U,9):" (P)",1:"")
- S NPWARD=$P(NURSASS(NURSANM),U,3) D EN7^NURSAUTL W ?6,$S(NPWARD'="":$E(NPWARD,1,10),1:$P(NURSASS(NURSANM),U,3))
- I $P(NDATA,U,3)'="" W ?19,$S($D(^NURSF(211.3,+$P(NDATA,U,3),0)):$P(^(0),U),1:$P(NDATA,U,3))
- I $P(NDATA,U,10)'="" W ?33,$S($D(^NURSF(211.6,+$P(NDATA,U,10),0)):$E($P(^(0),U),1,15),1:$P(NDATA,U,10))
- W ?49,$E(+NDATA,4,5)_"/"_$E(+NDATA,6,7)_"/"_$E(+NDATA,2,3) W:+$P(NDATA,U,6) ?59,$E(+$P(NDATA,U,6),4,5)_"/"_$E(+$P(NDATA,U,6),6,7)_"/"_$E(+$P(NDATA,U,6),2,3) W ?70,$J($P(NDATA,U,4),2,3)
- I $G(NURPLSW) W !,?2,$E($$EN13^NURSUT3(+$G(NURSASS(NURSANM))),1,17) S X=+$P(NDATA,U,3),Y=+$P(^NURSF(211.3,+X,0),U,7) W ?21,$E($$GET1^DIQ(212.7,+Y,.01,"I"),1,17)
- Q
- SETARY ; SET NURSASS ARRAY FROM NURAS ARRAY
- S NCNT=NCNT+1,NURSASS(NCNT)=NOD_U_NDA_U_NURAS(I,J,NOD,NDA)
- Q
- CKASN ; SET NURAS ARRAY FOR POSITIONS ACTIVE AFTER NURSTDT
- Q:$S(NURLS="A"&$P(NDATA,U,6)&($P(NDATA,U,6)<NURSTDT):1,NURLS="C"&(($P(NDATA,U,6)&($P(NDATA,U,6)<NURSTDT))):1,1:0)
- Q:$S(NURLS="P"&('$P(NDATA,U,6)!($P(NDATA,U,6)>DT)!($P(NDATA,U,6)<NURSTDT)!($P(NDATA,U)'<DT)):1,1:0)
- I $S(NURLS="P":1,1:0) S NURAS(9999999-$S($P(NDATA,U,6):$P(NDATA,U,6),1:9999998),1-$P(NDATA,U,9)+1,NOD,NDA)=$S($D(^NURSF(211.8,NOD,0)):$P(^(0),U,1,2),1:U)_U_NDATA Q
- S NURAS(9999999-$P(NDATA,U),1-$P(NDATA,U,9)+1,NOD,NDA)=$S($D(^NURSF(211.8,NOD,0)):$P(^(0),U,1,2),1:U)_U_NDATA
- Q
- MSG W $C(7),!!,"NEW ASSIGNMENTS MUST BE ADDED FROM THE CURRENT DISPLAY SCREEN." Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAED1 5051 printed Jan 18, 2025@03:20:23 Page 2
- NURAED1 ;HIRMFO/MD,RM-EDIT FOR POSITION ;8/19/97
- +1 ;;4.0;NURSING SERVICE;**3,12**;Apr 25, 1997
- +2 SET NUROUT=0
- SET NID=$SELECT($DATA(^NURSF(210,+NURSDBA,0)):$PIECE(^(0),U),1:"")
- DO STST^NURAED4
- if $GET(NUROUT)
- GOTO QB
- SELECT KILL NURSUL,NURSASS
- DO WRITE
- NOPOS IF '$ORDER(NURSASS(""))
- SET NURAES="N"
- WRITE !!,"THERE ARE NO ",$SELECT(NURLS="P":"PAST ",NURLS="C":"CURRENT ",1:""),"EMPLOYEE ASSIGNMENTS "
- if NURLS="P"
- WRITE "AFTER SELECTED DATE"
- NOPOS1 IF '$ORDER(NURSASS(""))
- IF NURLS="P"
- SET %=1
- WRITE !!,"Would you like to see this employee's current position(s)"
- DO YN^DICN
- if %=0
- WRITE !,$CHAR(7),"Answer 'YES' or 'NO'"
- if %=0
- GOTO NOPOS
- if %'>0!(%=2)
- QUIT
- SET NURLS="C"
- DO WRITE
- GOTO NOPOS
- +1 IF $ORDER(NURSASS(""))
- DO WRT1
- WRITE !!,"Enter selection or type ? for help: "
- READ NURAES:DTIME
- SET NURAES=$SELECT(NURAES="n":"N",1:NURAES)
- if NURAES=U!(NURAES="^^")!'$TEST
- SET NUROUT=1
- if $GET(NUROUT)!(NURAES="")
- GOTO QB
- +2 IF NURLS="P"
- IF NURAES="N"
- WRITE $CHAR(7),!!,"NEW ASSIGNMENTS MUST BE ADDED FROM THE CURRENT DISPLAY SCREEN"
- GOTO SELECT
- +3 WRITE !
- SET NURSBAD=0
- DO VALSEL^NURAED2
- IF NURSBAD
- DO MORHELP^NURAED4
- if $GET(NUROUT)
- GOTO QB
- GOTO SELECT
- +4 DO EN1^NURAED2
- if $GET(NUROUT)
- GOTO QB
- if $DATA(MSG)
- GOTO SELECT
- +5 SET NUR("CNTR")=0
- FOR NURSANM=0:0
- SET NURSANM=$ORDER(NURSASS(NURSANM))
- if NURSANM'>0
- QUIT
- DO VALE0^NURAED2
- +6 DO VALENT^NURAED2
- IF $GET(NUROUT)
- SET NUROUT=0
- GOTO SELECT
- +7 DO EN1^NURAED6
- if '$GET(NUROUT)&$ORDER(NURSASS(""))
- GOTO SELECT
- QB KILL %,NURCAT,NL1,X,Y,Z,MSG,NURSUL,NUR1,NUR2,NUR3,NURAES,NURAS,NUR10,NURSBAD,NX,NURY,NWARD
- QC ; KILL VARIABLES
- +1 KILL NURSW1,NID,NCNT,NURSASS,NDA,I,J,NPSPOS,NURTFTEE,NPWARD,NDATA,NURSANM,NOD,NURST,NURSTDT,DA,NURLS,NURSNPOS,NURSOPOS,NURSPOS,NURSX,NZ,NOD1,NOD2,NURSDFLT,NURFLAG
- +2 QUIT
- +1 SET IOP=ION
- DO ^%ZIS
- KILL IOP
- DO EN2^NURSUT0
- SET NNM=$SELECT($DATA(^VA(200,$PIECE(^NURSF(210,+NURSDBA,0),U),0)):$PIECE(^(0),U),1:+NURSDBA)
- SET NSSN=$SELECT($DATA(^VA(200,$PIECE(^NURSF(210,+NURSDBA,0),U),1)):$PIECE(^(1),U,9),1:"")
- +2 IF $DATA(^VA(200,$PIECE(^NURSF(210,+NURSDBA,0),U),0))
- WRITE @IOF,!!,?25,"EMPLOYEE: ",$PIECE(^VA(200,$PIECE(^NURSF(210,+NURSDBA,0),U),0),U)
- if $DATA(NPSPOS)
- WRITE ?$X+2,NPSPOS
- WRITE !,?25,"SSN: ",NSSN,!!
- +3 KILL NPTR,NNM,NPSPOS,NSSN
- +4 QUIT
- WRITE ; CALL TO DISPLAY THE POSITIONS FOR THIS STAFF MEMBER
- +1 ; +NURSDBA=210 FILE ENTRY, NURSTDT=DATE FOR WHICH LISTING BEGINS
- +2 KILL NURAS,NURASS
- SET NURSW1=1
- SET NCNT=0
- +3 FOR NOD=0:0
- SET NOD=$ORDER(^NURSF(211.8,"C",+NID,NOD))
- if NOD'>0
- QUIT
- FOR NDA=0:0
- SET NDA=$ORDER(^NURSF(211.8,"C",+NID,NOD,NDA))
- if NDA'>0
- QUIT
- IF $DATA(^NURSF(211.8,NOD,1,NDA,0))
- SET NDATA=^(0)
- DO CKASN
- +4 FOR I=-1:0
- SET I=$ORDER(NURAS(I))
- if I'>0
- QUIT
- FOR J=-1:0
- SET J=$ORDER(NURAS(I,J))
- if J'>0
- QUIT
- FOR NOD=0:0
- SET NOD=$ORDER(NURAS(I,J,NOD))
- if NOD'>0
- QUIT
- FOR NDA=0:0
- SET NDA=$ORDER(NURAS(I,J,NOD,NDA))
- if NDA'>0
- QUIT
- DO SETARY
- +5 QUIT
- WRT1 ; POSITION DISPLAY
- +1 FOR NURSANM=0:0
- SET NURSANM=$ORDER(NURSASS(NURSANM))
- if NURSANM'>0
- QUIT
- DO DISPLAY
- +2 if '$ORDER(NURSASS(""))
- QUIT
- +3 WRITE !!?24,"STATUS: ",$SELECT($PIECE(^NURSF(210,+NURSDBA,0),U,2)="A":"ACTIVE",$PIECE(^(0),U,2)="I":"INTERMITTENT",1:"INACTIVE")
- +4 SET DA=+NURSDBA
- KILL NPSPOS
- DO EN2^NURSUT0
- +5 IF $GET(NPSPOS)'=""
- WRITE !?6,"PRIMARY SERVICE POSITION: ",$EXTRACT($PIECE(^NURSF(211.3,NPSPOS(0),0),U,2),1,24)
- +6 IF NURPLSW
- IF $GET(NPSPOS(2))'=""
- WRITE !,"PRIMARY SVC. POS. PRODUCT LINE: ",NPSPOS(2)
- +7 IF NURPLSW
- IF $GET(NPSPOS(4))'=""
- WRITE !?1,"PRIMARY LOCATION PRODUCT LINE: ",NPSPOS(4)
- +8 IF $PIECE($GET(^DIC(213.9,1,0)),U,9)="Y"
- WRITE !?14,"PRIMARY FACILITY: ",$GET(NPSPOS(3))
- +9 IF $DATA(^NURSF(211.8,"C",+NID))
- SET NUR("DA")=+NURSDBA
- DO EN1^NURSUT2
- if +NURTFTEE&("C"[NURLS)
- WRITE !,?9,"TOTAL ASSIGNMENT FTEE: ",$JUSTIFY(NURTFTEE,2,3)
- +10 IF '$TEST
- WRITE !
- +11 KILL NURAS
- QUIT
- DISPLAY ; DATA DISPLAY
- +1 SET (NURPLSW,NURMDSW)=0
- DO EN9^NURSAGSP
- SET NDATA=$PIECE(NURSASS(NURSANM),U,5,14)
- +2 IF NURSW1
- WRITE !!,"LOCATION"_$SELECT($GET(NURPLSW):"/",1:""),?16,"POSITION"_$SELECT($GET(NURPLSW):"/",1:""),?33,"DUTY",?49,"START",?59,"VACANCY",?70,"FTEE"
- +3 IF NURSW1
- WRITE !
- if NURPLSW
- WRITE "PRODUCT LINE"
- if NURPLSW
- WRITE ?16,"PRODUCT LINE"
- WRITE ?33,"TOUR",?49,"DATE",?59,"DATE",!
- SET Z=""
- SET $PIECE(Z,"-",80)=""
- WRITE Z
- SET NURSW1=0
- +4 WRITE !,NURSANM,$SELECT($PIECE(NDATA,U,9):" (P)",1:"")
- +5 SET NPWARD=$PIECE(NURSASS(NURSANM),U,3)
- DO EN7^NURSAUTL
- WRITE ?6,$SELECT(NPWARD'="":$EXTRACT(NPWARD,1,10),1:$PIECE(NURSASS(NURSANM),U,3))
- +6 IF $PIECE(NDATA,U,3)'=""
- WRITE ?19,$SELECT($DATA(^NURSF(211.3,+$PIECE(NDATA,U,3),0)):$PIECE(^(0),U),1:$PIECE(NDATA,U,3))
- +7 IF $PIECE(NDATA,U,10)'=""
- WRITE ?33,$SELECT($DATA(^NURSF(211.6,+$PIECE(NDATA,U,10),0)):$EXTRACT($PIECE(^(0),U),1,15),1:$PIECE(NDATA,U,10))
- +8 WRITE ?49,$EXTRACT(+NDATA,4,5)_"/"_$EXTRACT(+NDATA,6,7)_"/"_$EXTRACT(+NDATA,2,3)
- if +$PIECE(NDATA,U,6)
- WRITE ?59,$EXTRACT(+$PIECE(NDATA,U,6),4,5)_"/"_$EXTRACT(+$PIECE(NDATA,U,6),6,7)_"/"_$EXTRACT(+$PIECE(NDATA,U,6),2,3)
- WRITE ?70,$JUSTIFY($PIECE(NDATA,U,4),2,3)
- +9 IF $GET(NURPLSW)
- WRITE !,?2,$EXTRACT($$EN13^NURSUT3(+$GET(NURSASS(NURSANM))),1,17)
- SET X=+$PIECE(NDATA,U,3)
- SET Y=+$PIECE(^NURSF(211.3,+X,0),U,7)
- WRITE ?21,$EXTRACT($$GET1^DIQ(212.7,+Y,.01,"I"),1,17)
- +10 QUIT
- SETARY ; SET NURSASS ARRAY FROM NURAS ARRAY
- +1 SET NCNT=NCNT+1
- SET NURSASS(NCNT)=NOD_U_NDA_U_NURAS(I,J,NOD,NDA)
- +2 QUIT
- CKASN ; SET NURAS ARRAY FOR POSITIONS ACTIVE AFTER NURSTDT
- +1 if $SELECT(NURLS="A"&$PIECE(NDATA,U,6)&($PIECE(NDATA,U,6)<NURSTDT)
- QUIT
- +2 if $SELECT(NURLS="P"&('$PIECE(NDATA,U,6)!($PIECE(NDATA,U,6)>DT)!($PIECE(NDATA,U,6)<NURSTDT)!($PIECE(NDATA,U)'<DT))
- QUIT
- +3 IF $SELECT(NURLS="P":1,1:0)
- SET NURAS(9999999-$SELECT($PIECE(NDATA,U,6):$PIECE(NDATA,U,6),1:9999998),1-$PIECE(NDATA,U,9)+1,NOD,NDA)=$SELECT($DATA(^NURSF(211.8,NOD,0)):$PIECE(^(0),U,1,2),1:U)_U_NDATA
- QUIT
- +4 SET NURAS(9999999-$PIECE(NDATA,U),1-$PIECE(NDATA,U,9)+1,NOD,NDA)=$SELECT($DATA(^NURSF(211.8,NOD,0)):$PIECE(^(0),U,1,2),1:U)_U_NDATA
- +5 QUIT
- MSG WRITE $CHAR(7),!!,"NEW ASSIGNMENTS MUST BE ADDED FROM THE CURRENT DISPLAY SCREEN."
- QUIT