Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: NURAED6

NURAED6.m

Go to the documentation of this file.
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