BPCPRBC ; IHS/OIT/MJL - ADD,DELETE, OR EDIT PROBLEM ;
;;1.5;BPC;;MAY 26, 2005
PRBEDIT(RESULT,BPCFLAG,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC EDITPROBLEM
EN ;
S U="^",XWBWRAP=1 K RESULT
I BPCFLAG="" S RESULT(1)=-1,RESULT(2)="NO EDIT FLAG RECEIVED!" D KILL Q
I BPCPARAM="" S RESULT(1)=-1,RESULT(2)="NO PARAMETERS RECEIVED!" D KILL Q
I $L(BPCPARAM,";")'=8 S RESULT(1)=-1,RESULT(2)="WRONG NUMBER OF DATA ITEMS SENT ("_$L(BPCPARAM,";")_"). 8 ITEMS EXPECTED!" D KILL Q
I "AED"'[BPCFLAG S RESULT(1)=-1,RESULT(2)="PROPER EDIT FLAG NOT SENT!" D KILL Q
D:BPCFLAG="A" ADD D:BPCFLAG="E" EDIT D:BPCFLAG="D" DELETE D KILL
Q
KILL ;
K BPCDIEN,BPCNARR,BPCLOCN,BPCONSET,BPCCLS,BPCSTAT,BPCPIEN,BPCNIEN,BPCLOCN,BPCERR,BPCLIEN,BPCCTR,BPCDX,BPCX,BPCDENT,BPCDMOD,BPCPRBID,BPCPRIEN,BPCNARCK
K BPCFLG
Q
ADD ;
S BPCDIEN=$P(BPCPARAM,";",1),BPCNARR=$P(BPCPARAM,";",2),BPCLOCN=$P(BPCPARAM,";",3),BPCONSET=$P(BPCPARAM,";",4),BPCCLS=$P(BPCPARAM,";",5),BPCSTAT=$P(BPCPARAM,";",6),BPCPIEN=$P(BPCPARAM,";",7)
I '$D(^DPT(BPCPIEN,0)) S RESULT(1)=-1,RESULT(2)="PATIENT IEN NOT DEFINED!" Q
I '$D(^ICD9(BPCDIEN,0)) S RESULT(1)=-1,RESULT(2)="DIAGNOSIS IEN NOT DEFINED!" Q
S (BPCDMOD,BPCDENT)=DT,BPCLIEN=$O(^DIC(4,"B",BPCLOCN,""))
I BPCONSET'="" S X=BPCONSET D ^%DT S BPCONSET=$S(Y'=-1:$P(Y,".",1),1:"")
I BPCLIEN="" S RESULT(1)=-1,RESULT(2)="UNKNOWN LOCATION SENT!" Q
S BPCNARCK=$E(BPCNARR,1,30)
S BPCFLG=0
I $D(^AUTNPOV("B",BPCNARCK)) D
.S S1="" F S S1=$O(^AUTNPOV("B",BPCNARCK,S1)) Q:S1="" D Q:BPCFLG
..S BPCNFLD=$P(^AUTNPOV(S1,0),U,1)
..I BPCNFLD=BPCNARR S BPCFLG=1,BPCNIEN=S1
I '$D(^AUTNPOV("B",BPCNARCK))!('BPCFLG) S BPCERR=0 D SETNAR I BPCERR S RESULT(1)=-1,RESULT(2)="UNABLE TO ADD PROBLEM NARRATIVE!" Q
S BPCCTR=0,BPCC="" F S BPCC=$O(^AUPNPROB("AA",BPCPIEN,BPCLIEN,BPCC)) Q:BPCC="" S BPCCTR=+($E(BPCC,2,999))
S BPCCTR=BPCCTR+1,BPCERR=0 D ADDPROB I BPCERR S RESULT(1)=-1,RESULT(2)="UNABLE TO ADD PROBLEM!" Q
D SETRES
Q
SETRES ;
S BPCLOCC=$P(^AUTTLOC(BPCLIEN,0),U,7)
S BPCLOCC=$S(BPCLOCC="":"UK",1:BPCLOCC)
S BPCPRBID=BPCLOCC_BPCCTR,BPCDX=$P(^ICD9(BPCDIEN,0),U,1)
S RESULT(1)=1,RESULT(2)="PROB"_U_$G(BPCPRBID)_U_$G(BPCDX)_U_$G(BPCSTAT)_U_$G(BPCONSET)_U_$G(BPCNARR)_U_$G(BPCPRB)_U_$G(BPCDENT)_U_$G(BPCDMOD)
Q
EDPROB ;
L +^AUPNPROB(0):10 I '$T S BPCERR=1 Q
K BPCFDA,BPCEMSG S BPCFDR="BPCFDA(1)",BPCPRIEN=BPCPRIEN_","
S BPCFDA(1,9000011,BPCPRIEN,.01)=BPCDIEN
S BPCFDA(1,9000011,BPCPRIEN,.03)=BPCDMOD
S BPCFDA(1,9000011,BPCPRIEN,.04)=BPCCLS
S BPCFDA(1,9000011,BPCPRIEN,.05)=BPCNIEN
;S BPCFDA(1,9000011,BPCPRIEN,.06)=BPCLIEN
;S BPCFDA(1,9000011,BPCPRIEN,.07)=BPCCTR
S BPCFDA(1,9000011,BPCPRIEN,.12)=BPCSTAT
S BPCFDA(1,9000011,BPCPRIEN,.13)=BPCONSET
D FILE^DIE("",BPCFDR,"BPCEMSG")
I $D(BPCEMSG("DIERR")) S BPCERR=1
S BPCPRB=$P(BPCPRIEN,",",1)
L -^AUPNPROB(0)
Q
ADDPROB ;
L +^AUPNPROB(0):10 I '$T S BPCERR=1 Q
K BPCFDA,BPCEMSG S BPCFDR="BPCFDA(1)"
S BPCFDA(1,9000011,"+1,",.01)=BPCDIEN
S BPCFDA(1,9000011,"+1,",.02)=BPCPIEN
S BPCFDA(1,9000011,"+1,",.03)=BPCDMOD
S BPCFDA(1,9000011,"+1,",.04)=BPCCLS
S BPCFDA(1,9000011,"+1,",.05)=BPCNIEN
S BPCFDA(1,9000011,"+1,",.06)=BPCLIEN
S BPCFDA(1,9000011,"+1,",.07)=BPCCTR
S BPCFDA(1,9000011,"+1,",.08)=BPCDENT
S BPCFDA(1,9000011,"+1,",.12)=BPCSTAT
S BPCFDA(1,9000011,"+1,",.13)=BPCONSET
D UPDATE^DIE("",BPCFDR,"","BPCEMSG")
I $D(BPCEMSG("DIERR")) S BPCERR=1
I 'BPCERR S BPCPRB=$P(^AUPNPROB(0),U,3)
L -^AUPNPROB(0)
Q
SETNAR ;
K BPCFDA,BPCEMSG
L +^AUTNPOV(0):10 I '$T S BPCERR=1 Q
S BPCFDR="BPCFDA(1)"
S BPCFDA(1,9999999.27,"+1,",.01)=BPCNARR D UPDATE^DIE("",BPCFDR,"","BPCEMSG")
I $D(BPCEMSG("DIERR")) S BPCERR=1
L -^AUTNPOV(0)
I 'BPCERR S BPCNIEN=$P(^AUTNPOV(0),U,3)
Q
EDIT ;
S BPCDIEN=$P(BPCPARAM,";",1),BPCNARR=$P(BPCPARAM,";",2),BPCLOCN=$P(BPCPARAM,";",3),BPCONSET=$P(BPCPARAM,";",4),BPCCLS=$P(BPCPARAM,";",5),BPCSTAT=$P(BPCPARAM,";",6),BPCPIEN=$P(BPCPARAM,";",7),BPCPRIEN=$P(BPCPARAM,";",8)
I '$D(^DPT(BPCPIEN,0)) S RESULT(1)=-1,RESULT(2)="PATIENT IEN NOT DEFINED!" Q
I '$D(^ICD9(BPCDIEN,0)) S RESULT(1)=-1,RESULT(2)="DIAGNOSIS IEN NOT DEFINED!" Q
S BPCDMOD=DT
I BPCONSET'="" S X=BPCONSET D ^%DT S BPCONSET=$S(Y'=-1:$P(Y,".",1),1:"")
S BPCLIEN=$O(^DIC(4,"B",BPCLOCN,""))
I BPCPRIEN="" S RESULT(1)=-1,RESULT(2)="NO PROBLEM IEN PRESENT!" Q
I '$D(^AUPNPROB(BPCPRIEN)) S RESULT(1)=-1,RESULT(2)="PROBLEM IEN DOES NOT MATCH A PROBLEM! IEN= "_BPCPRIEN Q
S BPCCTR=$P(^AUPNPROB(BPCPRIEN,0),U,7)
S BPCNARCK=$E(BPCNARR,1,30)
S BPCFLG=0
I $D(^AUTNPOV("B",BPCNARCK)) D
.S S1="" F S S1=$O(^AUTNPOV("B",BPCNARCK,S1)) Q:S1="" D Q:BPCFLG
..S BPCNFLD=$P(^AUTNPOV(S1,0),U,1)
..I BPCNFLD=BPCNARR S BPCFLG=1,BPCNIEN=S1
I '$D(^AUTNPOV("B",BPCNARCK))!('BPCFLG) S BPCERR=0 D SETNAR I BPCERR S RESULT(1)=-1,RESULT(2)="UNABLE TO ADD PROBLEM NARRATIVE!" Q
S BPCERR=0 D EDPROB I BPCERR S RESULT(1)=-1,RESULT(2)="UNABLE TO EDIT PROBLEM!" Q
D SETRES
Q
DELETE ;
S BPCPRIEN=$P(BPCPARAM,";",8)
I +BPCPRIEN=0 S RESULT(1)=-1,RESULT(2)="NO PROBLEM IEN!" Q
I '$D(^AUPNPROB(BPCPRIEN,0)) S RESULT(1)=-1,RESULT(2)="PROBLEM DOES NOT EXIST!" Q
S DIK="^AUPNPROB(",DA=BPCPRIEN D ^DIK
S RESULT(1)=1,RESULT(2)="PROBLEM DELETED!"
K DIK,DA
Q
BPCPRBC ; IHS/OIT/MJL - ADD,DELETE, OR EDIT PROBLEM ;
+1 ;;1.5;BPC;;MAY 26, 2005
PRBEDIT(RESULT,BPCFLAG,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC EDITPROBLEM
EN ;
+1 SET U="^"
SET XWBWRAP=1
KILL RESULT
+2 IF BPCFLAG=""
SET RESULT(1)=-1
SET RESULT(2)="NO EDIT FLAG RECEIVED!"
DO KILL
QUIT
+3 IF BPCPARAM=""
SET RESULT(1)=-1
SET RESULT(2)="NO PARAMETERS RECEIVED!"
DO KILL
QUIT
+4 IF $LENGTH(BPCPARAM,";")'=8
SET RESULT(1)=-1
SET RESULT(2)="WRONG NUMBER OF DATA ITEMS SENT ("_$LENGTH(BPCPARAM,";")_"). 8 ITEMS EXPECTED!"
DO KILL
QUIT
+5 IF "AED"'[BPCFLAG
SET RESULT(1)=-1
SET RESULT(2)="PROPER EDIT FLAG NOT SENT!"
DO KILL
QUIT
+6 IF BPCFLAG="A"
DO ADD
IF BPCFLAG="E"
DO EDIT
IF BPCFLAG="D"
DO DELETE
DO KILL
+7 QUIT
KILL ;
+1 KILL BPCDIEN,BPCNARR,BPCLOCN,BPCONSET,BPCCLS,BPCSTAT,BPCPIEN,BPCNIEN,BPCLOCN,BPCERR,BPCLIEN,BPCCTR,BPCDX,BPCX,BPCDENT,BPCDMOD,BPCPRBID,BPCPRIEN,BPCNARCK
+2 KILL BPCFLG
+3 QUIT
ADD ;
+1 SET BPCDIEN=$PIECE(BPCPARAM,";",1)
SET BPCNARR=$PIECE(BPCPARAM,";",2)
SET BPCLOCN=$PIECE(BPCPARAM,";",3)
SET BPCONSET=$PIECE(BPCPARAM,";",4)
SET BPCCLS=$PIECE(BPCPARAM,";",5)
SET BPCSTAT=$PIECE(BPCPARAM,";",6)
SET BPCPIEN=$PIECE(BPCPARAM,";",7)
+2 IF '$DATA(^DPT(BPCPIEN,0))
SET RESULT(1)=-1
SET RESULT(2)="PATIENT IEN NOT DEFINED!"
QUIT
+3 IF '$DATA(^ICD9(BPCDIEN,0))
SET RESULT(1)=-1
SET RESULT(2)="DIAGNOSIS IEN NOT DEFINED!"
QUIT
+4 SET (BPCDMOD,BPCDENT)=DT
SET BPCLIEN=$ORDER(^DIC(4,"B",BPCLOCN,""))
+5 IF BPCONSET'=""
SET X=BPCONSET
DO ^%DT
SET BPCONSET=$SELECT(Y'=-1:$PIECE(Y,".",1),1:"")
+6 IF BPCLIEN=""
SET RESULT(1)=-1
SET RESULT(2)="UNKNOWN LOCATION SENT!"
QUIT
+7 SET BPCNARCK=$EXTRACT(BPCNARR,1,30)
+8 SET BPCFLG=0
+9 IF $DATA(^AUTNPOV("B",BPCNARCK))
Begin DoDot:1
+10 SET S1=""
FOR
SET S1=$ORDER(^AUTNPOV("B",BPCNARCK,S1))
IF S1=""
QUIT
Begin DoDot:2
+11 SET BPCNFLD=$PIECE(^AUTNPOV(S1,0),U,1)
+12 IF BPCNFLD=BPCNARR
SET BPCFLG=1
SET BPCNIEN=S1
End DoDot:2
IF BPCFLG
QUIT
End DoDot:1
+13 IF '$DATA(^AUTNPOV("B",BPCNARCK))!('BPCFLG)
SET BPCERR=0
DO SETNAR
IF BPCERR
SET RESULT(1)=-1
SET RESULT(2)="UNABLE TO ADD PROBLEM NARRATIVE!"
QUIT
+14 SET BPCCTR=0
SET BPCC=""
FOR
SET BPCC=$ORDER(^AUPNPROB("AA",BPCPIEN,BPCLIEN,BPCC))
IF BPCC=""
QUIT
SET BPCCTR=+($EXTRACT(BPCC,2,999))
+15 SET BPCCTR=BPCCTR+1
SET BPCERR=0
DO ADDPROB
IF BPCERR
SET RESULT(1)=-1
SET RESULT(2)="UNABLE TO ADD PROBLEM!"
QUIT
+16 DO SETRES
+17 QUIT
SETRES ;
+1 SET BPCLOCC=$PIECE(^AUTTLOC(BPCLIEN,0),U,7)
+2 SET BPCLOCC=$SELECT(BPCLOCC="":"UK",1:BPCLOCC)
+3 SET BPCPRBID=BPCLOCC_BPCCTR
SET BPCDX=$PIECE(^ICD9(BPCDIEN,0),U,1)
+4 SET RESULT(1)=1
SET RESULT(2)="PROB"_U_$GET(BPCPRBID)_U_$GET(BPCDX)_U_$GET(BPCSTAT)_U_$GET(BPCONSET)_U_$GET(BPCNARR)_U_$GET(BPCPRB)_U_$GET(BPCDENT)_U_$GET(BPCDMOD)
+5 QUIT
EDPROB ;
+1 LOCK +^AUPNPROB(0):10
IF '$TEST
SET BPCERR=1
QUIT
+2 KILL BPCFDA,BPCEMSG
SET BPCFDR="BPCFDA(1)"
SET BPCPRIEN=BPCPRIEN_","
+3 SET BPCFDA(1,9000011,BPCPRIEN,.01)=BPCDIEN
+4 SET BPCFDA(1,9000011,BPCPRIEN,.03)=BPCDMOD
+5 SET BPCFDA(1,9000011,BPCPRIEN,.04)=BPCCLS
+6 SET BPCFDA(1,9000011,BPCPRIEN,.05)=BPCNIEN
+7 ;S BPCFDA(1,9000011,BPCPRIEN,.06)=BPCLIEN
+8 ;S BPCFDA(1,9000011,BPCPRIEN,.07)=BPCCTR
+9 SET BPCFDA(1,9000011,BPCPRIEN,.12)=BPCSTAT
+10 SET BPCFDA(1,9000011,BPCPRIEN,.13)=BPCONSET
+11 DO FILE^DIE("",BPCFDR,"BPCEMSG")
+12 IF $DATA(BPCEMSG("DIERR"))
SET BPCERR=1
+13 SET BPCPRB=$PIECE(BPCPRIEN,",",1)
+14 LOCK -^AUPNPROB(0)
+15 QUIT
ADDPROB ;
+1 LOCK +^AUPNPROB(0):10
IF '$TEST
SET BPCERR=1
QUIT
+2 KILL BPCFDA,BPCEMSG
SET BPCFDR="BPCFDA(1)"
+3 SET BPCFDA(1,9000011,"+1,",.01)=BPCDIEN
+4 SET BPCFDA(1,9000011,"+1,",.02)=BPCPIEN
+5 SET BPCFDA(1,9000011,"+1,",.03)=BPCDMOD
+6 SET BPCFDA(1,9000011,"+1,",.04)=BPCCLS
+7 SET BPCFDA(1,9000011,"+1,",.05)=BPCNIEN
+8 SET BPCFDA(1,9000011,"+1,",.06)=BPCLIEN
+9 SET BPCFDA(1,9000011,"+1,",.07)=BPCCTR
+10 SET BPCFDA(1,9000011,"+1,",.08)=BPCDENT
+11 SET BPCFDA(1,9000011,"+1,",.12)=BPCSTAT
+12 SET BPCFDA(1,9000011,"+1,",.13)=BPCONSET
+13 DO UPDATE^DIE("",BPCFDR,"","BPCEMSG")
+14 IF $DATA(BPCEMSG("DIERR"))
SET BPCERR=1
+15 IF 'BPCERR
SET BPCPRB=$PIECE(^AUPNPROB(0),U,3)
+16 LOCK -^AUPNPROB(0)
+17 QUIT
SETNAR ;
+1 KILL BPCFDA,BPCEMSG
+2 LOCK +^AUTNPOV(0):10
IF '$TEST
SET BPCERR=1
QUIT
+3 SET BPCFDR="BPCFDA(1)"
+4 SET BPCFDA(1,9999999.27,"+1,",.01)=BPCNARR
DO UPDATE^DIE("",BPCFDR,"","BPCEMSG")
+5 IF $DATA(BPCEMSG("DIERR"))
SET BPCERR=1
+6 LOCK -^AUTNPOV(0)
+7 IF 'BPCERR
SET BPCNIEN=$PIECE(^AUTNPOV(0),U,3)
+8 QUIT
EDIT ;
+1 SET BPCDIEN=$PIECE(BPCPARAM,";",1)
SET BPCNARR=$PIECE(BPCPARAM,";",2)
SET BPCLOCN=$PIECE(BPCPARAM,";",3)
SET BPCONSET=$PIECE(BPCPARAM,";",4)
SET BPCCLS=$PIECE(BPCPARAM,";",5)
SET BPCSTAT=$PIECE(BPCPARAM,";",6)
SET BPCPIEN=$PIECE(BPCPARAM,";",7)
SET BPCPRIEN=$PIECE(BPCPARAM,";",8)
+2 IF '$DATA(^DPT(BPCPIEN,0))
SET RESULT(1)=-1
SET RESULT(2)="PATIENT IEN NOT DEFINED!"
QUIT
+3 IF '$DATA(^ICD9(BPCDIEN,0))
SET RESULT(1)=-1
SET RESULT(2)="DIAGNOSIS IEN NOT DEFINED!"
QUIT
+4 SET BPCDMOD=DT
+5 IF BPCONSET'=""
SET X=BPCONSET
DO ^%DT
SET BPCONSET=$SELECT(Y'=-1:$PIECE(Y,".",1),1:"")
+6 SET BPCLIEN=$ORDER(^DIC(4,"B",BPCLOCN,""))
+7 IF BPCPRIEN=""
SET RESULT(1)=-1
SET RESULT(2)="NO PROBLEM IEN PRESENT!"
QUIT
+8 IF '$DATA(^AUPNPROB(BPCPRIEN))
SET RESULT(1)=-1
SET RESULT(2)="PROBLEM IEN DOES NOT MATCH A PROBLEM! IEN= "_BPCPRIEN
QUIT
+9 SET BPCCTR=$PIECE(^AUPNPROB(BPCPRIEN,0),U,7)
+10 SET BPCNARCK=$EXTRACT(BPCNARR,1,30)
+11 SET BPCFLG=0
+12 IF $DATA(^AUTNPOV("B",BPCNARCK))
Begin DoDot:1
+13 SET S1=""
FOR
SET S1=$ORDER(^AUTNPOV("B",BPCNARCK,S1))
IF S1=""
QUIT
Begin DoDot:2
+14 SET BPCNFLD=$PIECE(^AUTNPOV(S1,0),U,1)
+15 IF BPCNFLD=BPCNARR
SET BPCFLG=1
SET BPCNIEN=S1
End DoDot:2
IF BPCFLG
QUIT
End DoDot:1
+16 IF '$DATA(^AUTNPOV("B",BPCNARCK))!('BPCFLG)
SET BPCERR=0
DO SETNAR
IF BPCERR
SET RESULT(1)=-1
SET RESULT(2)="UNABLE TO ADD PROBLEM NARRATIVE!"
QUIT
+17 SET BPCERR=0
DO EDPROB
IF BPCERR
SET RESULT(1)=-1
SET RESULT(2)="UNABLE TO EDIT PROBLEM!"
QUIT
+18 DO SETRES
+19 QUIT
DELETE ;
+1 SET BPCPRIEN=$PIECE(BPCPARAM,";",8)
+2 IF +BPCPRIEN=0
SET RESULT(1)=-1
SET RESULT(2)="NO PROBLEM IEN!"
QUIT
+3 IF '$DATA(^AUPNPROB(BPCPRIEN,0))
SET RESULT(1)=-1
SET RESULT(2)="PROBLEM DOES NOT EXIST!"
QUIT
+4 SET DIK="^AUPNPROB("
SET DA=BPCPRIEN
DO ^DIK
+5 SET RESULT(1)=1
SET RESULT(2)="PROBLEM DELETED!"
+6 KILL DIK,DA
+7 QUIT
