BPCNOTEC ; IHS/OIT/MJL - FHL-6/14/96 - ADD,DELETE OR EDIT PROBLEM NOTE ;
;;1.5;BPC;;MAY 26, 2005
;
NOTEDIT(RESULT,BPCFLAG,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC EDITNOTE
EN ;
S U="^",XWBWRAP=1 K RESULT
S BPCFLAG=$G(BPCFLAG),BPCPARAM=$G(BPCPARAM)
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 BPCPRIEN,BPCLOCN,BPCNARR,BPCSTAT,BPCDENT,BPCLIEN,BPCNIEN,BPCCTR,BPCERR,BPCIENS,BPCX,BPCPLIEN,BPCNBR,BPCPRID,BPCNOTID,BPCNOTN
Q
ADD ;
S BPCPRIEN=$P(BPCPARAM,";",1,1),BPCLOCN=$P(BPCPARAM,";",3,3),BPCNARR=$P(BPCPARAM,";",5,5),BPCSTAT=$P(BPCPARAM,";",6,6)
I BPCLOCN="" S RESULT(1)=-1,RESULT(2)="NO LOCATION SENT!" Q
S BPCDENT=DT,BPCLIEN=$O(^DIC(4,"B",BPCLOCN,"")),BPCNIEN=""
I BPCPRIEN="" S RESULT(1)=-1,RESULT(2)="NO PROBLEM IEN SENT!" Q
I '$D(^AUPNPROB(BPCPRIEN,0)) S RESULT(1)=-1,RESULT(2)="PROBLEM IEN SENT IS NOT DEFINED!" Q
I BPCLIEN="" S RESULT(1)=-1,RESULT(2)="UNKNOWN LOCATION SENT!" Q
I $D(^AUPNPROB(BPCPRIEN,11,"B",BPCLIEN)) S BPCNIEN=$O(^AUPNPROB(BPCPRIEN,11,"B",BPCLIEN,""))
E D GETNIEN
I BPCNIEN="" S RESULT(1)=-1,RESULT(2)="UNABLE TO GET NOTE IEN!" Q
S BPCCTR=$P($G(^AUPNPROB(BPCPRIEN,11,BPCNIEN,11,0)),U,3)+1
S BPCERR=0 D ADDNOTE
I BPCERR S RESULT(1)=-1,RESULT(2)="UNABLE TO ADD NOTE!" Q
D SETRES
Q
ADDNOTE ;
L +^AUPNPROB(BPCPRIEN,0):10 I '$T Q
K BPCFDA,BPCEMSG S BPCFDR="BPCFDA(1)"
S BPCFDA(1,"9000011.11","?1,"_BPCPRIEN_",",.01)=BPCLIEN
S BPCIENS="+2,?1,"_BPCPRIEN_","
S BPCFDA(1,"9000011.1111",BPCIENS,.01)=BPCCTR
S BPCFDA(1,"9000011.1111",BPCIENS,.03)=BPCNARR
S BPCFDA(1,"9000011.1111",BPCIENS,.04)=BPCSTAT
S BPCFDA(1,"9000011.1111",BPCIENS,.05)=BPCDENT
S BPCFDA(1,"9000011.1111",BPCIENS,.06)=DUZ
D UPDATE^DIE("",BPCFDR,"","BPCEMSG")
I $D(BPCEMSG("DIERR")) S BPCERR=1
L -^AUPNPROB(BPCPRIEN,0)
Q
EDNOTE ;
L +^AUPNPROB(BPCPRIEN,0):10 I '$T Q
K BPCFDA,BPCEMSG S BPCFDR="BPCFDA(1)"
S BPCIENS=BPCNOTN_","_BPCNIEN_","_BPCPRIEN_","
S BPCFDA(1,"9000011.1111",BPCIENS,.01)=BPCNOTN
S BPCFDA(1,"9000011.1111",BPCIENS,.03)=BPCNARR
S BPCFDA(1,"9000011.1111",BPCIENS,.04)=BPCSTAT
;S BPCFDA(1,"9000011.1111",BPCIENS,.05)=BPCDENT
S BPCFDA(1,"9000011.1111",BPCIENS,.06)=DUZ
D FILE^DIE("",BPCFDR,"BPCEMSG")
I $D(BPCEMSG("DIERR")) S BPCERR=1
S BPCCTR=BPCNOTN
L -^AUPNPROB(BPCPRIEN,0)
Q
SETRES ;
S BPCX=^AUPNPROB(BPCPRIEN,0),BPCPLIEN=$P(BPCX,U,6),BPCNBR=$P(BPCX,U,7)
S BPCPRID=$P(^AUTTLOC(BPCPLIEN,0),U,7),BPCPRID=$S(BPCPRID="":"UK",1:BPCPRID)_BPCNBR
S BPCNOTID=$P(^AUTTLOC(BPCLIEN,0),U,7)_BPCCTR
S BPCX=BPCNIEN_U_BPCNOTID_U_BPCLIEN_U_BPCCTR_U_U_BPCNARR_U_BPCSTAT_U_BPCDENT_U_DUZ
S RESULT(1)=1,RESULT(2)=BPCX
Q
GETNIEN ;GET NOTE IEN
L +^AUPNPROB(BPCPRIEN,0):10 I '$T Q
K BPCFDA,BPCEMSG S BPCFDR="BPCFDA(1)"
S BPCIENS="+1,"_BPCPRIEN_","
S BPCFDA(1,"9000011.11",BPCIENS,.01)=BPCLIEN
D UPDATE^DIE("",BPCFDR,"","BPCEMSG")
I '$D(BPCEMSG("DIERR")) D GNIEN1
L -^AUPNPROB(BPCPRIEN,0)
Q
GNIEN1 ;
S BPCNIEN=$P(^AUPNPROB(BPCPRIEN,11,0),U,3)
Q
EDIT ;
S BPCPRIEN=$P(BPCPARAM,";",1),BPCNIEN=$P(BPCPARAM,";",2),BPCNOTN=$P(BPCPARAM,";",4),BPCNARR=$P(BPCPARAM,";",5),BPCSTAT=$P(BPCPARAM,";",6)
S BPCLOCN=$P(BPCPARAM,";",3)
S BPCLIEN=$S(BPCLOCN'="":$O(^DIC(4,"B",BPCLOCN,"")),1:DUZ(2))
I BPCPRIEN="" S RESULT(1)=-1,RESULT(2)="NO PROBLEM IEN SENT!" Q
I BPCNIEN="" S RESULT(1)=-1,RESULT(2)="NO NOTE IEN SENT!" Q
I BPCNOTN="" S RESULT(1)=-1,RESULT(2)="NO NOTE NUMBER SENT!" Q
I '$D(^AUPNPROB(BPCPRIEN,11,BPCNIEN,11,BPCNOTN,0)) S RESULT(1)=-1,RESULT(2)="NOTE DOES NOT EXIST!" Q
S BPCDENT=$P(^AUPNPROB(BPCPRIEN,11,BPCNIEN,11,BPCNOTN,0),U,5)
S BPCERR=0 D EDNOTE
I BPCERR S RESULT(1)=-1,RESULT(2)="NOTE UNABLE TO BE EDITED!" Q
D SETRES
Q
DELETE ;
S BPCPRIEN=$P(BPCPARAM,";",1,1),BPCNIEN=$P(BPCPARAM,";",2,2),BPCNOTN=$P(BPCPARAM,";",4,4),BPCNOTID=$P(BPCPARAM,";",8,8)
I BPCPRIEN="" S RESULT(1)=-1,RESULT(2)="NO PROBLEM IEN SENT!" Q
I BPCNIEN="" S RESULT(1)=-1,RESULT(2)="NO NOTE IEN SENT!" Q
I BPCNOTN="" S RESULT(1)=-1,RESULT(2)="NO NOTE NUMBER SENT!" Q
I BPCNOTID="" S RESULT(1)=-1,RESULT(2)="NO NOTE ID SENT!" Q
S DA=BPCNOTN,DA(1)=BPCNIEN,DA(2)=BPCPRIEN,DIK="^AUPNPROB("_DA(2)_",11,"_DA(1)_",11,"
D ^DIK S RESULT(1)=1,RESULT(2)="NOTE "_BPCNOTID_" DELETED!"
Q
BPCNOTEC ; IHS/OIT/MJL - FHL-6/14/96 - ADD,DELETE OR EDIT PROBLEM NOTE ;
+1 ;;1.5;BPC;;MAY 26, 2005
+2 ;
NOTEDIT(RESULT,BPCFLAG,BPCPARAM) ;EP CALL FROM REMOTE PROC: BPC EDITNOTE
EN ;
+1 SET U="^"
SET XWBWRAP=1
KILL RESULT
+2 SET BPCFLAG=$GET(BPCFLAG)
SET BPCPARAM=$GET(BPCPARAM)
+3 IF BPCFLAG=""
SET RESULT(1)=-1
SET RESULT(2)="NO EDIT FLAG RECEIVED!"
DO KILL
QUIT
+4 IF BPCPARAM=""
SET RESULT(1)=-1
SET RESULT(2)="NO PARAMETERS RECEIVED!"
DO KILL
QUIT
+5 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
+6 IF "AED"'[BPCFLAG
SET RESULT(1)=-1
SET RESULT(2)="PROPER EDIT FLAG NOT SENT!"
DO KILL
QUIT
+7 IF BPCFLAG="A"
DO ADD
IF BPCFLAG="E"
DO EDIT
IF BPCFLAG="D"
DO DELETE
DO KILL
+8 QUIT
KILL ;
+1 KILL BPCPRIEN,BPCLOCN,BPCNARR,BPCSTAT,BPCDENT,BPCLIEN,BPCNIEN,BPCCTR,BPCERR,BPCIENS,BPCX,BPCPLIEN,BPCNBR,BPCPRID,BPCNOTID,BPCNOTN
+2 QUIT
ADD ;
+1 SET BPCPRIEN=$PIECE(BPCPARAM,";",1,1)
SET BPCLOCN=$PIECE(BPCPARAM,";",3,3)
SET BPCNARR=$PIECE(BPCPARAM,";",5,5)
SET BPCSTAT=$PIECE(BPCPARAM,";",6,6)
+2 IF BPCLOCN=""
SET RESULT(1)=-1
SET RESULT(2)="NO LOCATION SENT!"
QUIT
+3 SET BPCDENT=DT
SET BPCLIEN=$ORDER(^DIC(4,"B",BPCLOCN,""))
SET BPCNIEN=""
+4 IF BPCPRIEN=""
SET RESULT(1)=-1
SET RESULT(2)="NO PROBLEM IEN SENT!"
QUIT
+5 IF '$DATA(^AUPNPROB(BPCPRIEN,0))
SET RESULT(1)=-1
SET RESULT(2)="PROBLEM IEN SENT IS NOT DEFINED!"
QUIT
+6 IF BPCLIEN=""
SET RESULT(1)=-1
SET RESULT(2)="UNKNOWN LOCATION SENT!"
QUIT
+7 IF $DATA(^AUPNPROB(BPCPRIEN,11,"B",BPCLIEN))
SET BPCNIEN=$ORDER(^AUPNPROB(BPCPRIEN,11,"B",BPCLIEN,""))
+8 IF '$TEST
DO GETNIEN
+9 IF BPCNIEN=""
SET RESULT(1)=-1
SET RESULT(2)="UNABLE TO GET NOTE IEN!"
QUIT
+10 SET BPCCTR=$PIECE($GET(^AUPNPROB(BPCPRIEN,11,BPCNIEN,11,0)),U,3)+1
+11 SET BPCERR=0
DO ADDNOTE
+12 IF BPCERR
SET RESULT(1)=-1
SET RESULT(2)="UNABLE TO ADD NOTE!"
QUIT
+13 DO SETRES
+14 QUIT
ADDNOTE ;
+1 LOCK +^AUPNPROB(BPCPRIEN,0):10
IF '$TEST
QUIT
+2 KILL BPCFDA,BPCEMSG
SET BPCFDR="BPCFDA(1)"
+3 SET BPCFDA(1,"9000011.11","?1,"_BPCPRIEN_",",.01)=BPCLIEN
+4 SET BPCIENS="+2,?1,"_BPCPRIEN_","
+5 SET BPCFDA(1,"9000011.1111",BPCIENS,.01)=BPCCTR
+6 SET BPCFDA(1,"9000011.1111",BPCIENS,.03)=BPCNARR
+7 SET BPCFDA(1,"9000011.1111",BPCIENS,.04)=BPCSTAT
+8 SET BPCFDA(1,"9000011.1111",BPCIENS,.05)=BPCDENT
+9 SET BPCFDA(1,"9000011.1111",BPCIENS,.06)=DUZ
+10 DO UPDATE^DIE("",BPCFDR,"","BPCEMSG")
+11 IF $DATA(BPCEMSG("DIERR"))
SET BPCERR=1
+12 LOCK -^AUPNPROB(BPCPRIEN,0)
+13 QUIT
EDNOTE ;
+1 LOCK +^AUPNPROB(BPCPRIEN,0):10
IF '$TEST
QUIT
+2 KILL BPCFDA,BPCEMSG
SET BPCFDR="BPCFDA(1)"
+3 SET BPCIENS=BPCNOTN_","_BPCNIEN_","_BPCPRIEN_","
+4 SET BPCFDA(1,"9000011.1111",BPCIENS,.01)=BPCNOTN
+5 SET BPCFDA(1,"9000011.1111",BPCIENS,.03)=BPCNARR
+6 SET BPCFDA(1,"9000011.1111",BPCIENS,.04)=BPCSTAT
+7 ;S BPCFDA(1,"9000011.1111",BPCIENS,.05)=BPCDENT
+8 SET BPCFDA(1,"9000011.1111",BPCIENS,.06)=DUZ
+9 DO FILE^DIE("",BPCFDR,"BPCEMSG")
+10 IF $DATA(BPCEMSG("DIERR"))
SET BPCERR=1
+11 SET BPCCTR=BPCNOTN
+12 LOCK -^AUPNPROB(BPCPRIEN,0)
+13 QUIT
SETRES ;
+1 SET BPCX=^AUPNPROB(BPCPRIEN,0)
SET BPCPLIEN=$PIECE(BPCX,U,6)
SET BPCNBR=$PIECE(BPCX,U,7)
+2 SET BPCPRID=$PIECE(^AUTTLOC(BPCPLIEN,0),U,7)
SET BPCPRID=$SELECT(BPCPRID="":"UK",1:BPCPRID)_BPCNBR
+3 SET BPCNOTID=$PIECE(^AUTTLOC(BPCLIEN,0),U,7)_BPCCTR
+4 SET BPCX=BPCNIEN_U_BPCNOTID_U_BPCLIEN_U_BPCCTR_U_U_BPCNARR_U_BPCSTAT_U_BPCDENT_U_DUZ
+5 SET RESULT(1)=1
SET RESULT(2)=BPCX
+6 QUIT
GETNIEN ;GET NOTE IEN
+1 LOCK +^AUPNPROB(BPCPRIEN,0):10
IF '$TEST
QUIT
+2 KILL BPCFDA,BPCEMSG
SET BPCFDR="BPCFDA(1)"
+3 SET BPCIENS="+1,"_BPCPRIEN_","
+4 SET BPCFDA(1,"9000011.11",BPCIENS,.01)=BPCLIEN
+5 DO UPDATE^DIE("",BPCFDR,"","BPCEMSG")
+6 IF '$DATA(BPCEMSG("DIERR"))
DO GNIEN1
+7 LOCK -^AUPNPROB(BPCPRIEN,0)
+8 QUIT
GNIEN1 ;
+1 SET BPCNIEN=$PIECE(^AUPNPROB(BPCPRIEN,11,0),U,3)
+2 QUIT
EDIT ;
+1 SET BPCPRIEN=$PIECE(BPCPARAM,";",1)
SET BPCNIEN=$PIECE(BPCPARAM,";",2)
SET BPCNOTN=$PIECE(BPCPARAM,";",4)
SET BPCNARR=$PIECE(BPCPARAM,";",5)
SET BPCSTAT=$PIECE(BPCPARAM,";",6)
+2 SET BPCLOCN=$PIECE(BPCPARAM,";",3)
+3 SET BPCLIEN=$SELECT(BPCLOCN'="":$ORDER(^DIC(4,"B",BPCLOCN,"")),1:DUZ(2))
+4 IF BPCPRIEN=""
SET RESULT(1)=-1
SET RESULT(2)="NO PROBLEM IEN SENT!"
QUIT
+5 IF BPCNIEN=""
SET RESULT(1)=-1
SET RESULT(2)="NO NOTE IEN SENT!"
QUIT
+6 IF BPCNOTN=""
SET RESULT(1)=-1
SET RESULT(2)="NO NOTE NUMBER SENT!"
QUIT
+7 IF '$DATA(^AUPNPROB(BPCPRIEN,11,BPCNIEN,11,BPCNOTN,0))
SET RESULT(1)=-1
SET RESULT(2)="NOTE DOES NOT EXIST!"
QUIT
+8 SET BPCDENT=$PIECE(^AUPNPROB(BPCPRIEN,11,BPCNIEN,11,BPCNOTN,0),U,5)
+9 SET BPCERR=0
DO EDNOTE
+10 IF BPCERR
SET RESULT(1)=-1
SET RESULT(2)="NOTE UNABLE TO BE EDITED!"
QUIT
+11 DO SETRES
+12 QUIT
DELETE ;
+1 SET BPCPRIEN=$PIECE(BPCPARAM,";",1,1)
SET BPCNIEN=$PIECE(BPCPARAM,";",2,2)
SET BPCNOTN=$PIECE(BPCPARAM,";",4,4)
SET BPCNOTID=$PIECE(BPCPARAM,";",8,8)
+2 IF BPCPRIEN=""
SET RESULT(1)=-1
SET RESULT(2)="NO PROBLEM IEN SENT!"
QUIT
+3 IF BPCNIEN=""
SET RESULT(1)=-1
SET RESULT(2)="NO NOTE IEN SENT!"
QUIT
+4 IF BPCNOTN=""
SET RESULT(1)=-1
SET RESULT(2)="NO NOTE NUMBER SENT!"
QUIT
+5 IF BPCNOTID=""
SET RESULT(1)=-1
SET RESULT(2)="NO NOTE ID SENT!"
QUIT
+6 SET DA=BPCNOTN
SET DA(1)=BPCNIEN
SET DA(2)=BPCPRIEN
SET DIK="^AUPNPROB("_DA(2)_",11,"_DA(1)_",11,"
+7 DO ^DIK
SET RESULT(1)=1
SET RESULT(2)="NOTE "_BPCNOTID_" DELETED!"
+8 QUIT
