NURAED6 ;HIRMFO/RM-DATA STORAGE TMP FOR THE POSITION EDIT ;7/11/90
;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; STORE PATIENT DATA FROM NURSASS(#) AND NURSPOS(#)
N DA W:$O(NURSPOS("")) !!?20,"Making changes now - hold a minute"
EN2 ; STORE DATA FOR POSITION EDIT
F NURSANM=0:0 S NURSANM=$O(NURSASS(NURSANM)) Q:NURSANM'>0 I $D(NURSPOS(NURSANM)) D ADD:NURSASS(NURSANM)="",DEL:NURSPOS(NURSANM)="",EDT:NURSASS(NURSANM)'=""&(NURSPOS(NURSANM)'="")
Q
ADD ; ADD NEW POSITION
S NURSNPOS=NURSPOS(NURSANM) D ADDP
Q
DEL ; DELETE EXISTING POSITION
S DA(1)=$P(NURSASS(NURSANM),U),DA=$P(NURSASS(NURSANM),U,2) D DELP
Q
EDT ; EDIT EXISTING POSITION
S DA(1)=$P(NURSASS(NURSANM),U),DA=$P(NURSASS(NURSANM),U,2)
I $P(NURSPOS(NURSANM),U,1,3)'=$P(NURSASS(NURSANM),U,3,5) D DELP S NURSNPOS=NURSPOS(NURSANM) D ADDP Q
EDFL ; ADD THE DATA FOR THE REST OF THE FIELDS
Q:DA(1)'>0!(DA'>0) K DR S DIE="^NURSF(211.8,"_DA(1)_",1,",DR=$S($P(NURSASS(NURSANM),U,7)=$P(NURSPOS(NURSANM),U,5):"",1:".03////"_$P(NURSPOS(NURSANM),U,5))
F NURSX=6:1:12 S NURSY=$P(NURSPOS(NURSANM),U,NURSX) I $P(NURSASS(NURSANM),U,NURSX+2)'=NURSY S DR=DR_$S($L(DR):";",1:"")_(NURSX-5)_$S(NURSY'="":"////",1:"///")_$S(NURSY'="":NURSY,1:"@")
D:DR'="" ^DIE
Q
DELP ;DELETE POSITION USING DIK
S DIK="^NURSF(211.8,DA(1),1," D ^DIK
Q
ADDP ; ADD A NEW POSITION USING FILE^DICN
S DA=-1,DA(1)=$O(^NURSF(211.8,"AA",+$P(NURSNPOS,U),$P(NURSNPOS,U,2),0)) I DA(1)'>0 S DIC="^NURSF(211.8,",DIC(0)="L",X=$P(NURSNPOS,U),DIC("DR")=".02///"_$P(NURSNPOS,U,2) K DD D FILE^DICN K DIC Q:+Y'>0 S DA(1)=+Y
S:'$D(^NURSF(211.8,DA(1),1,0)) ^(0)="^211.82ID^^"
S DIC="^NURSF(211.8,DA(1),1,",DIC(0)="L",X=$P(NURSNPOS,U,3),DIC("DR")=".02////"_$P(NURSNPOS,U,4)_";.03////"_$P(NURSNPOS,U,5)_$S($P(NURSNPOS,U,11):";6///"_$P(NURSNPOS,U,11),1:"") K DD D FILE^DICN K DIC
S DA=+Y,NUR=".01^1" D EN1^NURSUT1 S:NURSASS(NURSANM)'="" $P(NURSASS(NURSANM),U,8,13)="" D EDFL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURAED6 1918 printed Oct 16, 2024@18:20:03 Page 2
NURAED6 ;HIRMFO/RM-DATA STORAGE TMP FOR THE POSITION EDIT ;7/11/90
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; STORE PATIENT DATA FROM NURSASS(#) AND NURSPOS(#)
+1 NEW DA
if $ORDER(NURSPOS(""))
WRITE !!?20,"Making changes now - hold a minute"
EN2 ; STORE DATA FOR POSITION EDIT
+1 FOR NURSANM=0:0
SET NURSANM=$ORDER(NURSASS(NURSANM))
if NURSANM'>0
QUIT
IF $DATA(NURSPOS(NURSANM))
if NURSASS(NURSANM)=""
DO ADD
if NURSPOS(NURSANM)=""
DO DEL
if NURSASS(NURSANM)'=""&(NURSPOS(NURSANM)'="")
DO EDT
+2 QUIT
ADD ; ADD NEW POSITION
+1 SET NURSNPOS=NURSPOS(NURSANM)
DO ADDP
+2 QUIT
DEL ; DELETE EXISTING POSITION
+1 SET DA(1)=$PIECE(NURSASS(NURSANM),U)
SET DA=$PIECE(NURSASS(NURSANM),U,2)
DO DELP
+2 QUIT
EDT ; EDIT EXISTING POSITION
+1 SET DA(1)=$PIECE(NURSASS(NURSANM),U)
SET DA=$PIECE(NURSASS(NURSANM),U,2)
+2 IF $PIECE(NURSPOS(NURSANM),U,1,3)'=$PIECE(NURSASS(NURSANM),U,3,5)
DO DELP
SET NURSNPOS=NURSPOS(NURSANM)
DO ADDP
QUIT
EDFL ; ADD THE DATA FOR THE REST OF THE FIELDS
+1 if DA(1)'>0!(DA'>0)
QUIT
KILL DR
SET DIE="^NURSF(211.8,"_DA(1)_",1,"
SET DR=$SELECT($PIECE(NURSASS(NURSANM),U,7)=$PIECE(NURSPOS(NURSANM),U,5):"",1:".03////"_$PIECE(NURSPOS(NURSANM),U,5))
+2 FOR NURSX=6:1:12
SET NURSY=$PIECE(NURSPOS(NURSANM),U,NURSX)
IF $PIECE(NURSASS(NURSANM),U,NURSX+2)'=NURSY
SET DR=DR_$SELECT($LENGTH(DR):";",1:"")_(NURSX-5)_$SELECT(NURSY'="":"////",1:"///")_$SELECT(NURSY'="":NURSY,1:"@")
+3 if DR'=""
DO ^DIE
+4 QUIT
DELP ;DELETE POSITION USING DIK
+1 SET DIK="^NURSF(211.8,DA(1),1,"
DO ^DIK
+2 QUIT
ADDP ; ADD A NEW POSITION USING FILE^DICN
+1 SET DA=-1
SET DA(1)=$ORDER(^NURSF(211.8,"AA",+$PIECE(NURSNPOS,U),$PIECE(NURSNPOS,U,2),0))
IF DA(1)'>0
SET DIC="^NURSF(211.8,"
SET DIC(0)="L"
SET X=$PIECE(NURSNPOS,U)
SET DIC("DR")=".02///"_$PIECE(NURSNPOS,U,2)
KILL DD
DO FILE^DICN
KILL DIC
if +Y'>0
QUIT
SET DA(1)=+Y
+2 if '$DATA(^NURSF(211.8,DA(1),1,0))
SET ^(0)="^211.82ID^^"
+3 SET DIC="^NURSF(211.8,DA(1),1,"
SET DIC(0)="L"
SET X=$PIECE(NURSNPOS,U,3)
SET DIC("DR")=".02////"_$PIECE(NURSNPOS,U,4)_";.03////"_$PIECE(NURSNPOS,U,5)_$SELECT($PIECE(NURSNPOS,U,11):";6///"_$PIECE(NURSNPOS,U,11),1:"")
KILL DD
DO FILE^DICN
KILL DIC
+4 SET DA=+Y
SET NUR=".01^1"
DO EN1^NURSUT1
if NURSASS(NURSANM)'=""
SET $PIECE(NURSASS(NURSANM),U,8,13)=""
DO EDFL
+5 QUIT
