NURSAFU0 ;HIRMFO/RM,FT-SITE FILES Continued ;6/11/96
;;4.0;NURSING SERVICE;**41**;Apr 25, 1997
EN1 ; ENTRY FROM OPTION NURSFL-PRIV PRIVILEGE FILE EDIT
Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),"^",1)=1
W ! S DLAYGO=212.6,DIC="^NURSF(212.6,",DIC(0)="AELQMNZ",DIC("A")="Enter Privilege: " D ^DIC K DIC G:+Y'>0 Q1 S DIE="^NURSF(212.6,",DR=".01;",DA=+Y D ^DIE G EN1
Q1 D ^NURSKILL Q
EN2 ; ENTRY FROM OPTION NURSSP-CONVPR CONVERSION NAME CHANGE PRINT
W ! S DIC="^NURSF(219.7,",L=0,BY="[NURS-SORT BY TYPE/OLD NAME]",(FR,TO)="?,?",FLDS="[NURS-PRINT ENTRIES]"
W !,"Enter (B)ulletin,(H)elp Frame,(O)ption, or (R)outine to define the type sort",!,"parameter. The default FIRST// will display all types in the above sequence."
W !,"The letters N/A in the type field indicates that an item is inapplicable to",!,"this version of the package.",!
D EN1^DIP,^NURSKILL
Q
EN3 ; ENTRY FROM NURAFL-SPO SERVICE POSITION FILE EDIT
S X=$G(^DIC(213.9,1,"OFF")) Q:X=""!(X=1)
W ! S DLAYGO=211.3,DIC="^NURSF(211.3,",DIC(0)="AELQM",DIC("A")="Select Service Position abbreviation: "
S DIC("DR")="" ;S DIC("DR")="1NAME;2PRIORITY SEQUENCE;S:$$EN7^NURSAFU0()'=""Y"" Y=""@1"";6R~PRODUCT LINE;S:X=1 Y=""@2"";@1;6///^S X=""NURSING"";@2;4SERVICE CATEGORY;S:X'=""R"" Y=0;3AMIS POSITION"
D ^DIC K DIC G:+Y'>0 Q3 S NURANEW=+$P(Y,"^",3),DDSFILE="^NURSF(211.3,",DR="[NURA-I-SERVICE]",DA=+Y D ^DDS G EN3 ;S DIE="^NURSF(211.3,",DR="[NURA-I-SERVICE]",DIE("NO^")="OUTOK",DA=+Y D ^DIE G EN3
Q3 K NURSWT,NURANEW D ^NURSKILL Q
REQD ; Code called from post action of Page 1 of NURA-I-SERVICE form.
; This code will delete an entry in 211.3, if all required data not
; present, and entry is new.
N NURADATA,DIK
Q:+$G(DA)'>0
;VMP OIFO BAY PINES;ELR;NUR*4.0*41 ADDED NEXT LINE
Q:+$G(NURANEW)'>0
S NURADATA=$G(^NURSF(211.3,DA,0))
I $P(NURADATA,"^",1)=""!($P(NURADATA,"^",2)="")!($P(NURADATA,"^",3)="")!($P(NURADATA,"^",5)="")!($P(NURADATA,"^",7)="") S DIK="^NURSF(211.3," D ^DIK W $C(7),!!,"ALL REQUIRED DATA NOT PRESENT, ENTRY DELETED!!"
Q
EN4 ; ENTRY FROM NURAFL-TOD TOUR OF DUTY FILE EDIT
Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),U,1)=1
W ! S DLAYGO=211.6,DIC="^NURSF(211.6,",DIC(0)="AELQMZ",DIC("A")="Enter Tour of Duty: " D ^DIC K DIC G:+Y'>0 Q4 S DIE="^NURSF(211.6,",DR=".01;1",DA=+Y,DIE("NO^")="OUTOK" D ^DIE G EN4
Q4 D ^NURSKILL Q
EN5 ; ENTRY FROM NURAFL-VAC VACANCY REASON FILE EDIT
Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),U,1)=1
W ! S DLAYGO=211.9,DIC="^NURSF(211.9,",DIC(0)="AELQMZ",DIC("A")="Enter Vacancy Reason Code: " D ^DIC K DIC G:+Y'>0 Q5 S DIE="^NURSF(211.9,",DR=".01;1;2",DA=+Y,DIE("NO^")="OUTOK" D:'$P(Y,"^",3) ^DIE G EN5
Q5 D ^NURSKILL Q
EN6 ; Entry from NURSFL-PROD-LINE, PRODUCT LINE FILE EDIT
Q:'$D(^DIC(213.9,1,"OFF")) Q:$P(^DIC(213.9,1,"OFF"),U,1)=1
S NURSEDIT=1
W ! K DIC S DIC="^NURSF(212.7,",DIC(0)="AELMQZ",DLAYGO=212.7,DIC("A")="Select PRODUCT LINE NAME: "
D ^DIC I +Y'>0 K DIC,DLAYGO Q
I +Y=1,Y(0)="NURSING" W !,"NAME: NURSING// (Uneditable)" G EN6
S DA=+Y,DIE="^NURSF(212.7,",DR=.01 D ^DIE K DA,DIE,DR Q:$D(Y)
G EN6
EN7() ; Return PRODUCT LINE site parameter value
; values are: Y - Yes
; N - No
; - Null
Q $P($G(^DIC(213.9,1,0)),U,8)
;
EN8() ; Return FACILITY site parameter value
; values are: Y - Yes
; N - No
; - Null
Q $P($G(^DIC(213.9,1,0)),U,9)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURSAFU0 3425 printed Apr 09, 2024@21:21:42 Page 2
NURSAFU0 ;HIRMFO/RM,FT-SITE FILES Continued ;6/11/96
+1 ;;4.0;NURSING SERVICE;**41**;Apr 25, 1997
EN1 ; ENTRY FROM OPTION NURSFL-PRIV PRIVILEGE FILE EDIT
+1 if '$DATA(^DIC(213.9,1,"OFF"))
QUIT
if $PIECE(^DIC(213.9,1,"OFF"),"^",1)=1
QUIT
+2 WRITE !
SET DLAYGO=212.6
SET DIC="^NURSF(212.6,"
SET DIC(0)="AELQMNZ"
SET DIC("A")="Enter Privilege: "
DO ^DIC
KILL DIC
if +Y'>0
GOTO Q1
SET DIE="^NURSF(212.6,"
SET DR=".01;"
SET DA=+Y
DO ^DIE
GOTO EN1
Q1 DO ^NURSKILL
QUIT
EN2 ; ENTRY FROM OPTION NURSSP-CONVPR CONVERSION NAME CHANGE PRINT
+1 WRITE !
SET DIC="^NURSF(219.7,"
SET L=0
SET BY="[NURS-SORT BY TYPE/OLD NAME]"
SET (FR,TO)="?,?"
SET FLDS="[NURS-PRINT ENTRIES]"
+2 WRITE !,"Enter (B)ulletin,(H)elp Frame,(O)ption, or (R)outine to define the type sort",!,"parameter. The default FIRST// will display all types in the above sequence."
+3 WRITE !,"The letters N/A in the type field indicates that an item is inapplicable to",!,"this version of the package.",!
+4 DO EN1^DIP
DO ^NURSKILL
+5 QUIT
EN3 ; ENTRY FROM NURAFL-SPO SERVICE POSITION FILE EDIT
+1 SET X=$GET(^DIC(213.9,1,"OFF"))
if X=""!(X=1)
QUIT
+2 WRITE !
SET DLAYGO=211.3
SET DIC="^NURSF(211.3,"
SET DIC(0)="AELQM"
SET DIC("A")="Select Service Position abbreviation: "
+3 ;S DIC("DR")="1NAME;2PRIORITY SEQUENCE;S:$$EN7^NURSAFU0()'=""Y"" Y=""@1"";6R~PRODUCT LINE;S:X=1 Y=""@2"";@1;6///^S X=""NURSING"";@2;4SERVICE CATEGORY;S:X'=""R"" Y=0;3AMIS POSITION"
SET DIC("DR")=""
+4 ;S DIE="^NURSF(211.3,",DR="[NURA-I-SERVICE]",DIE("NO^")="OUTOK",DA=+Y D ^DIE G EN3
DO ^DIC
KILL DIC
if +Y'>0
GOTO Q3
SET NURANEW=+$PIECE(Y,"^",3)
SET DDSFILE="^NURSF(211.3,"
SET DR="[NURA-I-SERVICE]"
SET DA=+Y
DO ^DDS
GOTO EN3
Q3 KILL NURSWT,NURANEW
DO ^NURSKILL
QUIT
REQD ; Code called from post action of Page 1 of NURA-I-SERVICE form.
+1 ; This code will delete an entry in 211.3, if all required data not
+2 ; present, and entry is new.
+3 NEW NURADATA,DIK
+4 if +$GET(DA)'>0
QUIT
+5 ;VMP OIFO BAY PINES;ELR;NUR*4.0*41 ADDED NEXT LINE
+6 if +$GET(NURANEW)'>0
QUIT
+7 SET NURADATA=$GET(^NURSF(211.3,DA,0))
+8 IF $PIECE(NURADATA,"^",1)=""!($PIECE(NURADATA,"^",2)="")!($PIECE(NURADATA,"^",3)="")!($PIECE(NURADATA,"^",5)="")!($PIECE(NURADATA,"^",7)="")
SET DIK="^NURSF(211.3,"
DO ^DIK
WRITE $CHAR(7),!!,"ALL REQUIRED DATA NOT PRESENT, ENTRY DELETED!!"
+9 QUIT
EN4 ; ENTRY FROM NURAFL-TOD TOUR OF DUTY FILE EDIT
+1 if '$DATA(^DIC(213.9,1,"OFF"))
QUIT
if $PIECE(^DIC(213.9,1,"OFF"),U,1)=1
QUIT
+2 WRITE !
SET DLAYGO=211.6
SET DIC="^NURSF(211.6,"
SET DIC(0)="AELQMZ"
SET DIC("A")="Enter Tour of Duty: "
DO ^DIC
KILL DIC
if +Y'>0
GOTO Q4
SET DIE="^NURSF(211.6,"
SET DR=".01;1"
SET DA=+Y
SET DIE("NO^")="OUTOK"
DO ^DIE
GOTO EN4
Q4 DO ^NURSKILL
QUIT
EN5 ; ENTRY FROM NURAFL-VAC VACANCY REASON FILE EDIT
+1 if '$DATA(^DIC(213.9,1,"OFF"))
QUIT
if $PIECE(^DIC(213.9,1,"OFF"),U,1)=1
QUIT
+2 WRITE !
SET DLAYGO=211.9
SET DIC="^NURSF(211.9,"
SET DIC(0)="AELQMZ"
SET DIC("A")="Enter Vacancy Reason Code: "
DO ^DIC
KILL DIC
if +Y'>0
GOTO Q5
SET DIE="^NURSF(211.9,"
SET DR=".01;1;2"
SET DA=+Y
SET DIE("NO^")="OUTOK"
if '$PIECE(Y,"^",3)
DO ^DIE
GOTO EN5
Q5 DO ^NURSKILL
QUIT
EN6 ; Entry from NURSFL-PROD-LINE, PRODUCT LINE FILE EDIT
+1 if '$DATA(^DIC(213.9,1,"OFF"))
QUIT
if $PIECE(^DIC(213.9,1,"OFF"),U,1)=1
QUIT
+2 SET NURSEDIT=1
+3 WRITE !
KILL DIC
SET DIC="^NURSF(212.7,"
SET DIC(0)="AELMQZ"
SET DLAYGO=212.7
SET DIC("A")="Select PRODUCT LINE NAME: "
+4 DO ^DIC
IF +Y'>0
KILL DIC,DLAYGO
QUIT
+5 IF +Y=1
IF Y(0)="NURSING"
WRITE !,"NAME: NURSING// (Uneditable)"
GOTO EN6
+6 SET DA=+Y
SET DIE="^NURSF(212.7,"
SET DR=.01
DO ^DIE
KILL DA,DIE,DR
if $DATA(Y)
QUIT
+7 GOTO EN6
EN7() ; Return PRODUCT LINE site parameter value
+1 ; values are: Y - Yes
+2 ; N - No
+3 ; - Null
+4 QUIT $PIECE($GET(^DIC(213.9,1,0)),U,8)
+5 ;
EN8() ; Return FACILITY site parameter value
+1 ; values are: Y - Yes
+2 ; N - No
+3 ; - Null
+4 QUIT $PIECE($GET(^DIC(213.9,1,0)),U,9)
+5 ;
