NURSAFLL.m

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

NURSAFLL  ;HIRMFO/RM,MD,FT-LOOKUP FOR FILE 211.4 ;10/10/96  13:03

 +1       ;;4.0;NURSING SERVICE;;Apr 25, 1997

EN1       ; RETURNS Y=-1 IF NO SELECTION

 +1        KILL DTOUT,DUOUT

           SET NUREXIT=0

           SET NUR=$ORDER(^DIC(40.9,"C","NU",""))

           IF NUR'>0

               SET Y=-1

               WRITE !,$CHAR(7),"Need to add Nursing to the LOCATION TYPE (#40.9) File"

               GOTO Q

 +2        IF '$DATA(DIC(0))!'($DATA(DIC)#2)

               QUIT 

 +3        IF $SELECT('($DATA(X)#2):1,X="":1,1:0)&(DIC(0)'["A")

               SET Y=-1

               QUIT 

 +4        KILL Y,NURDICR

           IF $DATA(DICR)

               SET %Y="NURDICR("

               SET %X="DICR("

               DO %XY^%RCR

               SET NURDICR=DICR

               KILL DICR

 +5        IF DIC(0)'["A"

               SET NURTMX=X

           SET NURDIC=DIC

           IF $DATA(DIC)\10

               SET NUR=""

               FOR NUR(0)=0:0

                   SET NUR=$ORDER(DIC(NUR))

                   IF NUR=""

                       QUIT 

                   SET NURDIC(NUR)=DIC(NUR)

READ      ;

 +1        SET X=$$EN8^NURSAFU0()

           SET NURMDSW=$SELECT(X="Y":1,1:0)

 +2        IF $$SITE^VASITE()'>0

               WRITE *7,!?5,"Cannot identify your Primary Station Number.",!?5,"Please contact your ADPAC or IRM Support Person.",!

               SET Y=-1

               QUIT 

 +3        KILL X,DIC

           IF NURDIC(0)'["A"

               SET X=NURTMX

           SET DIC=NURDIC

           IF $DATA(NURDIC)\10

               SET NUR=""

               FOR NUR(0)=0:0

                   SET NUR=$ORDER(NURDIC(NUR))

                   IF NUR=""

                       QUIT 

                   SET DIC(NUR)=NURDIC(NUR)

 +4        IF DIC(0)["A"

               WRITE !,$SELECT('$DATA(DIC("A")):"Select NURSING UNIT NAME: ",1:DIC("A"))_$SELECT('$DATA(DIC("B")):"",1:$SELECT(DIC("B")?1"NUR ".E:$PIECE(DIC("B"),"NUR ",2),1:DIC("B"))_"// ")

 +5       IF $TEST

               READ X:DTIME

               IF X="^"

                   SET DUOUT=1

               IF '$TEST

                   SET X="^"

                   SET DTOUT=1

               IF X=""&$TEST&$DATA(DIC("B"))

                   SET X=DIC("B")

               SET NURTMX=X

               IF "^"[X

                   SET Y=-1

                   GOTO Q

 +6        IF X?1"?".E

               DO HELP

               IF DIC(0)["A"

                   GOTO READ

               GOTO Q

 +7        SET DIC(0)="EI"

           SET DIC="^NURSF(211.4,"

           SET X=$SELECT(X=" "!(X?1"NUR ".E):X,1:"NUR "_X)

           DO ^DIC

 +8        IF +Y'>0

               IF NURDIC(0)["M"&(NURTMX'?1"NUR ".E)

                   DO MULT

               IF +Y'>0

                   IF $SELECT(NURDIC(0)'["L":1,'$DATA(DLAYGO):0,DLAYGO=211.4:0,1:1)

                       IF NURDIC(0)["Q"

                           WRITE $CHAR(7)," ??"

                       IF NURDIC(0)["A"

                           GOTO READ

                       GOTO Q

 +9        IF +Y>0

               GOTO Q

           KILL NURLAY

           IF $DATA(DLAYGO)

               SET NURLAY=DLAYGO

 +10       KILL DIC

           SET X=NURTMX

           SET X=$SELECT(X=" "!(X?1"NUR ".E):X,X?1"""".E1"""":"""NUR "_$EXTRACT(X,2,$LENGTH(X)),1:"NUR "_X)

           SET DLAYGO=44

           SET DIC="^SC("

           SET DIC(0)="EL"

           SET DIC("W")=""

           SET DIC("S")="I NUR=$P(^(0),U,22)"

 +11       SET 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"

 +12       DO ^DIC

           KILL DIC("S"),DIC("DR"),DLAYGO

           IF $DATA(NURDIC("S"))

               SET DIC("S")=NURDIC("S")

           IF $DATA(NURDIC("DR"))

               SET DIC("DR")=NURDIC("DR")

           IF $DATA(NURLAY)

               SET DLAYGO=NURLAY

           KILL NURLAY

 +13       IF +Y'>0

               IF DIC(0)["Q"

                   WRITE $CHAR(7),"  ??"

               IF DIC(0)["A"

                   GOTO READ

               GOTO Q

 +14       SET X="`"_+Y

           SET NUR=+Y

 +15       IF $DATA(NURDIC("W"))

               SET DIC("W")=NURDIC("W")

           SET DIC="^NURSF(211.4,"

           SET DIC(0)=$SELECT(NURDIC(0)["E":"E",1:"")_"IL"

           DO ^DIC

           IF +Y'>0

               SET DA=NUR

               SET DIK="^SC("

               DO ^DIK

               IF NURDIC["Q"

                   WRITE $CHAR(7)," ??"

               IF NURDIC(0)["A"

                   GOTO READ

Q          IF $DATA(NURDICR)

               KILL DICR

               SET DICR=NURDICR

               SET %X="NURDICR("

               SET %Y="DICR("

               DO %XY^%RCR

 +1        KILL DIC

           SET DIC=NURDIC

           IF $DATA(NURDIC)\10

               SET NUR=""

               FOR NUR(0)=0:0

                   SET NUR=$ORDER(NURDIC(NUR))

                   IF NUR=""

                       QUIT 

                   SET DIC(NUR)=NURDIC(NUR)

 +2        SET X=NURTMX

           IF DIC(0)["Z"

               IF +Y>0

                   SET Y(0)=$SELECT($DATA(^NURSF(211.4,+Y,0)):^(0),1:"")

                   SET Y(0,0)=$SELECT($PIECE(Y(0),"^")="":"",$DATA(^SC($PIECE(Y(0),"^"),0)):$PIECE(^(0),"^"),1:"")

                   SET Y(0,0)=$SELECT(Y(0,0)?1"NUR ".E:$PIECE(Y(0,0),"NUR ",2),1:Y(0,0))

 +3        KILL NURA,NUR,NURDIC,NURTMX,NURX,NURY,NURZ,NURDICR,NUREXIT

 +4        QUIT 

HELP      ;

 +1        SET NUREXIT=0

           SET U="^"

           IF $$VFIELD^DILFD(211.4,.01,3)

               DO FIELD^DID(211.4,.01,"","HELP-PROMPT","NURX")

               DO FIELD^DID(211.4,.01,"","XECUTABLE HELP","NURY")

               IF $DATA(NURX("HELP-PROMPT"))

                   WRITE !,NURX("HELP-PROMPT")

               IF $DATA(NURY("XECUTABLE HELP"))

                   XECUTE NURY("XECUTABLE HELP")

HP1        IF X'?2"?".E

               SET %=""

               WRITE !?2,"DO YOU WANT THE ENTIRE "_$SELECT($PIECE(^NURSF(211.4,0),"^",4)&'$DATA(DIC("S")):$PIECE(^NURSF(211.4,0),"^",4)_"-ENTRY ",1:"")_"NURSING UNIT LIST"

               DO YN^DICN

               IF %=-1!(%=2)

                   DO CHK

               IF %=-1!(%=2)

                   QUIT 

               IF %=0

                   WRITE !?5,"ANSWER YES OR NO"

                   GOTO HP1

 +1        SET NURA=0

           SET NURX="NUR "

           WRITE !!,"CHOOSE FROM:"

           FOR NURX(0)=0:0

               SET NURX=$ORDER(^SC("B",NURX))

               IF NURX'?1"NUR ".E!NUREXIT

                   QUIT 

               FOR NURY=0:0

                   SET NURY=$ORDER(^SC("B",NURX,NURY))

                   IF NURY'>0

                       QUIT 

                   FOR Y=0:0

                       SET Y=$ORDER(^NURSF(211.4,"B",NURY,Y))

                       IF Y'>0

                           QUIT 

                       DO SCR

 +2       ;S X=$S(X?2"?".E:"??",1:"?"),DIC="^NURSF(211.4,",DIC(0)="EQI" D ^DIC

 +3        QUIT 

UPS       ;

 +1        READ !,"'^' TO STOP ",NURZ:DTIME

           SET NURA=0

           SET NUREXIT=$SELECT(NURZ="^"!'$TEST:1,1:0)

 +2        QUIT 

SCR       ;

 +1        SET ZZ=$$EN12^NURSUT3($GET(Y))

           SET YY=$GET(^NURSF(211.4,+Y,"I"))

           IF 1

 +2        IF $DATA(DIC("S"))

               XECUTE DIC("S")

           IF $TEST

               WRITE !?5,$PIECE(NURX,"NUR ",2),?32,$SELECT(YY="I":"**INACTIVE**",1:""),?50,$SELECT($PIECE($GET(^DIC(213.9,1,0)),U,9)="Y":$EXTRACT(ZZ,1,15),1:"")

               SET NURA=NURA+1

               IF NURA=10

                   DO UPS

               IF NUREXIT

                   QUIT 

 +3        QUIT 

CHK       ;

 +1        SET NUREXIT=1

           SET X=""

           SET Y=""

 +2        QUIT 

MULT      ; MULTIPLE LOOKUP

 +1        KILL DIC

           SET X=NURTMX

           SET DIC(0)="E"

           SET DIC="^DIC(42,"

           SET D="B"

           SET DIC("S")="I $D(^NURSF(211.4,""C"",+Y))"

           DO IX^DIC

           KILL DIC

           IF +Y>0

               IF $DATA(NURDIC("S"))

                   SET DIC("S")=NURDIC("S")

               SET X=+Y

               SET DIC(0)="I"_$SELECT(NURDIC(0)["E":"E",1:"")

               SET DIC="^NURSF(211.4,"

               SET D="C"

               DO IX^DIC

 +2        QUIT