- 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
