BPCRC6 ; IHS/OIT/MJL - FHL-12/26/96 - REFERRED CARE GUI ROUTINES ;
;;1.5;BPC;;MAY 26, 2005
;
EDIT ; EP CALLED FROM BPCRC3 (EDITS REFERRED CARE RECORD)
D MODREF I BPCERR S RESULT(1)=-1,RESULT(2)="ERROR OCCURRED WHILE MODIFYING DATA!" Q
S RESULT(1)=1,RESULT(2)=BPCRIEN_U_BPCREFN_U_BPCPURP_U_BPCPRNAM_U_BPCPROV_U_BPCIDAT_U_BPCEBDAT_U
Q
MODREF ;
L +^BMCREF(0):10 I '$T S BPCERR=1 Q
K BPCFDA,BPCEMSG S BPCFDR="BPCFDA(1)",BPCIENS=BPCRIEN_","
S BPCFDA(1,90001,BPCIENS,.01)=BPCIDAT
S BPCFDA(1,90001,BPCIENS,.03)=BPCPIEN
S BPCFDA(1,90001,BPCIENS,.04)=BPCRTYPE
S BPCFDA(1,90001,BPCIENS,.05)=BPCFAC
S BPCFDA(1,90001,BPCIENS,.06)=BPCPROV
S BPCFDA(1,90001,BPCIENS,.07)=BPCPVEND
S BPCFDA(1,90001,BPCIENS,.08)=BPCTOIHS
S BPCFDA(1,90001,BPCIENS,.09)=BPCTOPRV
S BPCFDA(1,90001,BPCIENS,.11)=BPCPAYOR
S BPCFDA(1,90001,BPCIENS,.12)=BPCICD
S BPCFDA(1,90001,BPCIENS,.13)=BPCCPT
S BPCFDA(1,90001,BPCIENS,.14)=BPCPTYPE
S BPCFDA(1,90001,BPCIENS,.21)=BPCDRG
S BPCFDA(1,90001,BPCIENS,.23)=BPCCLIN
S BPCFDA(1,90001,BPCIENS,.27)=BPCCDAT ;DATE LAST MODIFIED FOR EDITS
S BPCFDA(1,90001,BPCIENS,.32)=BPCPRIOR
S BPCFDA(1,90001,BPCIENS,.34)=BPCSNDA
S BPCFDA(1,90001,BPCIENS,1105)=BPCEBDAT
S BPCFDA(1,90001,BPCIENS,1107)=BPCEEDAT
S BPCFDA(1,90001,BPCIENS,1109)=BPCLOS
S BPCFDA(1,90001,BPCIENS,1111)=BPCNOVIS
S BPCFDA(1,90001,BPCIENS,1201)=BPCPURP
S BPCFDA(1,90001,BPCIENS,1301)=BPCSNOTE
S BPCFDA(1,90001,BPCIENS,1302)=BPCWDAYS
D FILE^DIE("",BPCFDR,"BPCEMSG")
I $D(BPCEMSG("DIERR")) S BPCERR=1
L -^BMCREF(0)
I 'BPCERR D MODLSCAT
I 'BPCERR D MODHX
I 'BPCERR D MODDXS
I 'BPCERR D MODPXS
Q
MODDXS ;
K BPCARY
S BPCX="" F S BPCX=$O(^BMCDX("AD",BPCRIEN,BPCX)) Q:BPCX="" S BPCARY(BPCX)=""
I $D(BPCARY) S DIK="^BMCDX(" D DEL
K BPCARY,DA
Q:BPCDXS=""
D SETDXS^BPCRC5
Q
MODPXS ;
K BPCARY
S BPCX="" F S BPCX=$O(^BMCPX("AD",BPCRIEN,BPCX)) Q:BPCX="" S BPCARY(BPCX)=""
I $D(BPCARY) S DIK="^BMCPX(" D DEL
K BPCARY,DA
Q:BPCPRCS=""
D SETPRCS^BPCRC5
Q
MODHX ;
K BPCARY
S BPCX=0 F S BPCX=$O(^BMCREF(BPCRIEN,1,BPCX)) Q:BPCX="" S BPCARY(BPCX)=""
I $D(BPCARY) S BPCSUB="1",DA(1)=BPCRIEN,DIK="^BMCREF("_DA(1)_","_BPCSUB_"," D DEL
K BPCARY,DA
Q:BPCHXS=""
D ADDHX
Q
MODLSCAT ;
K BPCARY
S BPCX="" F S BPCX=$O(^BMCREF(BPCRIEN,21,"B",BPCX)) Q:BPCX="" S BPCQ="" F S BPCQ=$O(^BMCREF(BPCRIEN,21,"B",BPCX,BPCQ)) Q:BPCQ="" S BPCARY(BPCQ)=""
I $D(BPCARY) S BPCSUB="21",DA(1)=BPCRIEN,DIK="^BMCREF("_DA(1)_","_BPCSUB_"," D DEL
K BPCARY,DA
Q:BPCLSCAT=""
D ADDLSCAT
Q
DEL ;
S DA="" F S DA=$O(BPCARY(DA)) Q:DA="" D ^DIK
Q
ADDHX ;
K ^BPCTMP($J),BPCEMSG
F BPCQ=1:1:$L(BPCHXS,BPCS2) S BPCX=$P(BPCHXS,BPCS2,BPCQ),^BPCTMP($J,BPCQ,0)=BPCX
S BPCROOT="^BPCTMP("_$J_")"
D WP^DIE(90001,BPCRIEN_",",1,"",BPCROOT,"BPCEMSG")
I $D(BPCEMSG("DIERR")) S BPCERR=1
K ^BPCTMP($J)
Q
ADDLSCAT ;
L +^BMCREF(0):10 I '$T S BPCERR=1 Q
K BPCFDA,BPCEMSG S BPCFDR="BPCFDA(1)",BPCIENS=BPCRIEN_","
S BPCSUB=1 F BPCQ=1:1:$L(BPCLSCAT,BPCS2) S BPCX=$P(BPCLSCAT,BPCS2,BPCQ),BPCSUB=BPCSUB+1,BPCXR="BPCFDA(1,90001.21,"_""""_"+"_BPCSUB_","_BPCIENS_""""_",.01)" S @BPCXR=BPCX
D UPDATE^DIE("",BPCFDR,"BPCIEN","BPCEMSG")
L -^BMCREF(0)
Q
BPCRC6 ; IHS/OIT/MJL - FHL-12/26/96 - REFERRED CARE GUI ROUTINES ;
+1 ;;1.5;BPC;;MAY 26, 2005
+2 ;
EDIT ; EP CALLED FROM BPCRC3 (EDITS REFERRED CARE RECORD)
+1 DO MODREF
IF BPCERR
SET RESULT(1)=-1
SET RESULT(2)="ERROR OCCURRED WHILE MODIFYING DATA!"
QUIT
+2 SET RESULT(1)=1
SET RESULT(2)=BPCRIEN_U_BPCREFN_U_BPCPURP_U_BPCPRNAM_U_BPCPROV_U_BPCIDAT_U_BPCEBDAT_U
+3 QUIT
MODREF ;
+1 LOCK +^BMCREF(0):10
IF '$TEST
SET BPCERR=1
QUIT
+2 KILL BPCFDA,BPCEMSG
SET BPCFDR="BPCFDA(1)"
SET BPCIENS=BPCRIEN_","
+3 SET BPCFDA(1,90001,BPCIENS,.01)=BPCIDAT
+4 SET BPCFDA(1,90001,BPCIENS,.03)=BPCPIEN
+5 SET BPCFDA(1,90001,BPCIENS,.04)=BPCRTYPE
+6 SET BPCFDA(1,90001,BPCIENS,.05)=BPCFAC
+7 SET BPCFDA(1,90001,BPCIENS,.06)=BPCPROV
+8 SET BPCFDA(1,90001,BPCIENS,.07)=BPCPVEND
+9 SET BPCFDA(1,90001,BPCIENS,.08)=BPCTOIHS
+10 SET BPCFDA(1,90001,BPCIENS,.09)=BPCTOPRV
+11 SET BPCFDA(1,90001,BPCIENS,.11)=BPCPAYOR
+12 SET BPCFDA(1,90001,BPCIENS,.12)=BPCICD
+13 SET BPCFDA(1,90001,BPCIENS,.13)=BPCCPT
+14 SET BPCFDA(1,90001,BPCIENS,.14)=BPCPTYPE
+15 SET BPCFDA(1,90001,BPCIENS,.21)=BPCDRG
+16 SET BPCFDA(1,90001,BPCIENS,.23)=BPCCLIN
+17 ;DATE LAST MODIFIED FOR EDITS
SET BPCFDA(1,90001,BPCIENS,.27)=BPCCDAT
+18 SET BPCFDA(1,90001,BPCIENS,.32)=BPCPRIOR
+19 SET BPCFDA(1,90001,BPCIENS,.34)=BPCSNDA
+20 SET BPCFDA(1,90001,BPCIENS,1105)=BPCEBDAT
+21 SET BPCFDA(1,90001,BPCIENS,1107)=BPCEEDAT
+22 SET BPCFDA(1,90001,BPCIENS,1109)=BPCLOS
+23 SET BPCFDA(1,90001,BPCIENS,1111)=BPCNOVIS
+24 SET BPCFDA(1,90001,BPCIENS,1201)=BPCPURP
+25 SET BPCFDA(1,90001,BPCIENS,1301)=BPCSNOTE
+26 SET BPCFDA(1,90001,BPCIENS,1302)=BPCWDAYS
+27 DO FILE^DIE("",BPCFDR,"BPCEMSG")
+28 IF $DATA(BPCEMSG("DIERR"))
SET BPCERR=1
+29 LOCK -^BMCREF(0)
+30 IF 'BPCERR
DO MODLSCAT
+31 IF 'BPCERR
DO MODHX
+32 IF 'BPCERR
DO MODDXS
+33 IF 'BPCERR
DO MODPXS
+34 QUIT
MODDXS ;
+1 KILL BPCARY
+2 SET BPCX=""
FOR
SET BPCX=$ORDER(^BMCDX("AD",BPCRIEN,BPCX))
IF BPCX=""
QUIT
SET BPCARY(BPCX)=""
+3 IF $DATA(BPCARY)
SET DIK="^BMCDX("
DO DEL
+4 KILL BPCARY,DA
+5 IF BPCDXS=""
QUIT
+6 DO SETDXS^BPCRC5
+7 QUIT
MODPXS ;
+1 KILL BPCARY
+2 SET BPCX=""
FOR
SET BPCX=$ORDER(^BMCPX("AD",BPCRIEN,BPCX))
IF BPCX=""
QUIT
SET BPCARY(BPCX)=""
+3 IF $DATA(BPCARY)
SET DIK="^BMCPX("
DO DEL
+4 KILL BPCARY,DA
+5 IF BPCPRCS=""
QUIT
+6 DO SETPRCS^BPCRC5
+7 QUIT
MODHX ;
+1 KILL BPCARY
+2 SET BPCX=0
FOR
SET BPCX=$ORDER(^BMCREF(BPCRIEN,1,BPCX))
IF BPCX=""
QUIT
SET BPCARY(BPCX)=""
+3 IF $DATA(BPCARY)
SET BPCSUB="1"
SET DA(1)=BPCRIEN
SET DIK="^BMCREF("_DA(1)_","_BPCSUB_","
DO DEL
+4 KILL BPCARY,DA
+5 IF BPCHXS=""
QUIT
+6 DO ADDHX
+7 QUIT
MODLSCAT ;
+1 KILL BPCARY
+2 SET BPCX=""
FOR
SET BPCX=$ORDER(^BMCREF(BPCRIEN,21,"B",BPCX))
IF BPCX=""
QUIT
SET BPCQ=""
FOR
SET BPCQ=$ORDER(^BMCREF(BPCRIEN,21,"B",BPCX,BPCQ))
IF BPCQ=""
QUIT
SET BPCARY(BPCQ)=""
+3 IF $DATA(BPCARY)
SET BPCSUB="21"
SET DA(1)=BPCRIEN
SET DIK="^BMCREF("_DA(1)_","_BPCSUB_","
DO DEL
+4 KILL BPCARY,DA
+5 IF BPCLSCAT=""
QUIT
+6 DO ADDLSCAT
+7 QUIT
DEL ;
+1 SET DA=""
FOR
SET DA=$ORDER(BPCARY(DA))
IF DA=""
QUIT
DO ^DIK
+2 QUIT
ADDHX ;
+1 KILL ^BPCTMP($JOB),BPCEMSG
+2 FOR BPCQ=1:1:$LENGTH(BPCHXS,BPCS2)
SET BPCX=$PIECE(BPCHXS,BPCS2,BPCQ)
SET ^BPCTMP($JOB,BPCQ,0)=BPCX
+3 SET BPCROOT="^BPCTMP("_$JOB_")"
+4 DO WP^DIE(90001,BPCRIEN_",",1,"",BPCROOT,"BPCEMSG")
+5 IF $DATA(BPCEMSG("DIERR"))
SET BPCERR=1
+6 KILL ^BPCTMP($JOB)
+7 QUIT
ADDLSCAT ;
+1 LOCK +^BMCREF(0):10
IF '$TEST
SET BPCERR=1
QUIT
+2 KILL BPCFDA,BPCEMSG
SET BPCFDR="BPCFDA(1)"
SET BPCIENS=BPCRIEN_","
+3 SET BPCSUB=1
FOR BPCQ=1:1:$LENGTH(BPCLSCAT,BPCS2)
SET BPCX=$PIECE(BPCLSCAT,BPCS2,BPCQ)
SET BPCSUB=BPCSUB+1
SET BPCXR="BPCFDA(1,90001.21,"_""""_"+"_BPCSUB_","_BPCIENS_""""_",.01)"
SET @BPCXR=BPCX
+4 DO UPDATE^DIE("",BPCFDR,"BPCIEN","BPCEMSG")
+5 LOCK -^BMCREF(0)
+6 QUIT
