source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURSAFLL.m@ 1397

NURSAFLL ;HIRMFO/RM,MD,FT-LOOKUP FOR FILE 211.4 ;10/10/96  13:03
 ;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; RETURNS Y=-1 IF NO SELECTION
 K DTOUT,DUOUT S NUREXIT=0,NUR=$O(^DIC(40.9,"C","NU","")) I NUR'>0 S Y=-1 W !,$C(7),"Need to add Nursing to the LOCATION TYPE (#40.9) File" G Q
 Q:'$D(DIC(0))!'($D(DIC)#2)
 I $S('($D(X)#2):1,X="":1,1:0)&(DIC(0)'["A") S Y=-1 Q
 K Y,NURDICR I $D(DICR) S %Y="NURDICR(",%X="DICR(" D %XY^%RCR S NURDICR=DICR K DICR
 S:DIC(0)'["A" NURTMX=X S NURDIC=DIC I $D(DIC)\10 S NUR="" F NUR(0)=0:0 S NUR=$O(DIC(NUR)) Q:NUR=""  S NURDIC(NUR)=DIC(NUR)
READ ;
 S X=$$EN8^NURSAFU0(),NURMDSW=$S(X="Y":1,1:0)
 I $$SITE^VASITE()'>0 W *7,!?5,"Cannot identify your Primary Station Number.",!?5,"Please contact your ADPAC or IRM Support Person.",! S Y=-1 Q
 K X,DIC S:NURDIC(0)'["A" X=NURTMX S DIC=NURDIC I $D(NURDIC)\10 S NUR="" F NUR(0)=0:0 S NUR=$O(NURDIC(NUR)) Q:NUR=""  S DIC(NUR)=NURDIC(NUR)
 I DIC(0)["A" W !,$S('$D(DIC("A")):"Select NURSING UNIT NAME: ",1:DIC("A"))_$S('$D(DIC("B")):"",1:$S(DIC("B")?1"NUR ".E:$P(DIC("B"),"NUR ",2),1:DIC("B"))_"// ")
 I  R X:DTIME S:X="^" DUOUT=1 S:'$T X="^",DTOUT=1 S:X=""&$T&$D(DIC("B")) X=DIC("B") S NURTMX=X I "^"[X S Y=-1 G Q
 I X?1"?".E D HELP G READ:DIC(0)["A",Q
 S DIC(0)="EI",DIC="^NURSF(211.4,",X=$S(X=" "!(X?1"NUR ".E):X,1:"NUR "_X) D ^DIC
 I +Y'>0 D:NURDIC(0)["M"&(NURTMX'?1"NUR ".E) MULT I +Y'>0,$S(NURDIC(0)'["L":1,'$D(DLAYGO):0,DLAYGO=211.4:0,1:1) W:NURDIC(0)["Q" $C(7)," ??" G READ:NURDIC(0)["A",Q
 G:+Y>0 Q K NURLAY S:$D(DLAYGO) NURLAY=DLAYGO
 K DIC S X=NURTMX,X=$S(X=" "!(X?1"NUR ".E):X,X?1"""".E1"""":"""NUR "_$E(X,2,$L(X)),1:"NUR "_X),DLAYGO=44,DIC="^SC(",DIC(0)="EL",DIC("W")="",DIC("S")="I NUR=$P(^(0),U,22)"
 S DIC("DR")="2///^S X=""Z"";2.1///^S X=""NURSING"";S:'$G(NURMDSW) Y=""@1"";3;S Y=""@2"";@1;3///^S X=""`""_+$$SITE^VASITE();@2"
 D ^DIC K DIC("S"),DIC("DR"),DLAYGO S:$D(NURDIC("S")) DIC("S")=NURDIC("S") S:$D(NURDIC("DR")) DIC("DR")=NURDIC("DR") S:$D(NURLAY) DLAYGO=NURLAY K NURLAY
 I +Y'>0 W:DIC(0)["Q" $C(7),"  ??" G READ:DIC(0)["A",Q
 S X="`"_+Y,NUR=+Y
 S:$D(NURDIC("W")) DIC("W")=NURDIC("W") S DIC="^NURSF(211.4,",DIC(0)=$S(NURDIC(0)["E":"E",1:"")_"IL" D ^DIC I +Y'>0 S DA=NUR,DIK="^SC(" D ^DIK W:NURDIC["Q" $C(7)," ??" G READ:NURDIC(0)["A"
Q I $D(NURDICR) K DICR S DICR=NURDICR,%X="NURDICR(",%Y="DICR(" D %XY^%RCR
 K DIC S DIC=NURDIC I $D(NURDIC)\10 S NUR="" F NUR(0)=0:0 S NUR=$O(NURDIC(NUR)) Q:NUR=""  S DIC(NUR)=NURDIC(NUR)
 S X=NURTMX I DIC(0)["Z",+Y>0 S Y(0)=$S($D(^NURSF(211.4,+Y,0)):^(0),1:""),Y(0,0)=$S($P(Y(0),"^")="":"",$D(^SC($P(Y(0),"^"),0)):$P(^(0),"^"),1:""),Y(0,0)=$S(Y(0,0)?1"NUR ".E:$P(Y(0,0),"NUR ",2),1:Y(0,0))
 K NURA,NUR,NURDIC,NURTMX,NURX,NURY,NURZ,NURDICR,NUREXIT
 Q
HELP ;
 S NUREXIT=0,U="^" I $$VFIELD^DILFD(211.4,.01,3) D FIELD^DID(211.4,.01,"","HELP-PROMPT","NURX"),FIELD^DID(211.4,.01,"","XECUTABLE HELP","NURY") W:$D(NURX("HELP-PROMPT")) !,NURX("HELP-PROMPT") X:$D(NURY("XECUTABLE HELP")) NURY("XECUTABLE HELP")
HP1 I X'?2"?".E S %="" W !?2,"DO YOU WANT THE ENTIRE "_$S($P(^NURSF(211.4,0),"^",4)&'$D(DIC("S")):$P(^NURSF(211.4,0),"^",4)_"-ENTRY ",1:"")_"NURSING UNIT LIST" D YN^DICN D:%=-1!(%=2) CHK Q:%=-1!(%=2)  I %=0 W !?5,"ANSWER YES OR NO" G HP1
 S NURA=0,NURX="NUR " W !!,"CHOOSE FROM:" F NURX(0)=0:0 S NURX=$O(^SC("B",NURX)) Q:NURX'?1"NUR ".E!NUREXIT  F NURY=0:0 S NURY=$O(^SC("B",NURX,NURY)) Q:NURY'>0  F Y=0:0 S Y=$O(^NURSF(211.4,"B",NURY,Y)) Q:Y'>0  D SCR
 ;S X=$S(X?2"?".E:"??",1:"?"),DIC="^NURSF(211.4,",DIC(0)="EQI" D ^DIC
 Q
UPS ;
 R !,"'^' TO STOP ",NURZ:DTIME S NURA=0,NUREXIT=$S(NURZ="^"!'$T:1,1:0)
 Q
SCR ;
 S ZZ=$$EN12^NURSUT3($G(Y)),YY=$G(^NURSF(211.4,+Y,"I")) I 1
 X:$D(DIC("S")) DIC("S") I $T W !?5,$P(NURX,"NUR ",2),?32,$S(YY="I":"**INACTIVE**",1:""),?50,$S($P($G(^DIC(213.9,1,0)),U,9)="Y":$E(ZZ,1,15),1:"") S NURA=NURA+1 D:NURA=10 UPS Q:NUREXIT
 Q
CHK ;
 S NUREXIT=1,X="",Y=""
 Q
MULT ; MULTIPLE LOOKUP
 K DIC S X=NURTMX,DIC(0)="E",DIC="^DIC(42,",D="B",DIC("S")="I $D(^NURSF(211.4,""C"",+Y))" D IX^DIC K DIC I +Y>0 S:$D(NURDIC("S")) DIC("S")=NURDIC("S") S X=+Y,DIC(0)="I"_$S(NURDIC(0)["E":"E",1:""),DIC="^NURSF(211.4,",D="C" D IX^DIC
 Q