- 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
