source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURSAFLL.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1NURSAFLL ;HIRMFO/RM,MD,FT-LOOKUP FOR FILE 211.4 ;10/10/96 13:03
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3EN1 ; RETURNS Y=-1 IF NO SELECTION
4 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
5 Q:'$D(DIC(0))!'($D(DIC)#2)
6 I $S('($D(X)#2):1,X="":1,1:0)&(DIC(0)'["A") S Y=-1 Q
7 K Y,NURDICR I $D(DICR) S %Y="NURDICR(",%X="DICR(" D %XY^%RCR S NURDICR=DICR K DICR
8 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)
9READ ;
10 S X=$$EN8^NURSAFU0(),NURMDSW=$S(X="Y":1,1:0)
11 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
12 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)
13 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"))_"// ")
14 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
15 I X?1"?".E D HELP G READ:DIC(0)["A",Q
16 S DIC(0)="EI",DIC="^NURSF(211.4,",X=$S(X=" "!(X?1"NUR ".E):X,1:"NUR "_X) D ^DIC
17 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
18 G:+Y>0 Q K NURLAY S:$D(DLAYGO) NURLAY=DLAYGO
19 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)"
20 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"
21 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
22 I +Y'>0 W:DIC(0)["Q" $C(7)," ??" G READ:DIC(0)["A",Q
23 S X="`"_+Y,NUR=+Y
24 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"
25Q I $D(NURDICR) K DICR S DICR=NURDICR,%X="NURDICR(",%Y="DICR(" D %XY^%RCR
26 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)
27 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))
28 K NURA,NUR,NURDIC,NURTMX,NURX,NURY,NURZ,NURDICR,NUREXIT
29 Q
30HELP ;
31 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")
32HP1 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
33 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
34 ;S X=$S(X?2"?".E:"??",1:"?"),DIC="^NURSF(211.4,",DIC(0)="EQI" D ^DIC
35 Q
36UPS ;
37 R !,"'^' TO STOP ",NURZ:DTIME S NURA=0,NUREXIT=$S(NURZ="^"!'$T:1,1:0)
38 Q
39SCR ;
40 S ZZ=$$EN12^NURSUT3($G(Y)),YY=$G(^NURSF(211.4,+Y,"I")) I 1
41 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
42 Q
43CHK ;
44 S NUREXIT=1,X="",Y=""
45 Q
46MULT ; MULTIPLE LOOKUP
47 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
48 Q
Note: See TracBrowser for help on using the repository browser.