source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURAED1.m@ 1651

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
HEADER ;HEADER FOR ALL INPUTS
 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