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 Oct 16, 2024@18:19:58 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
