BPCRXALG ; IHS/OIT/MJL - GUI RX ALLERGY DISPLAY ;
;;1.5;BPC;;MAY 26, 2005
;;
GETALG(BGUARRAY,BPCPIEN) ;EP CALL
; FROM REMOTE PROC: BPC RXALLERGY DATA
;BGUARRAY is return array
;BPCPIEN is patient IEN
;
EN ;ENTRY POINT FOR TESTING
;S BPCPIEN=12382
S JOB=$J,BPCGUI=1,XWBWRAP=1
S BGUARRAY="^XTMP(""BPCRXALG"","_$J_")"
K @BGUARRAY
;
;check patient IEN
S BPCERR=0
I $G(BPCPIEN)="" S ^XTMP("BPCRXALG",JOB,1)=-1,^(2)="PATIENT IEN NOT SENT!" D KILL S BPCERR=1 Q
;
CALL ;CALLS GMRADPT TO CREATE DATA
;check if Allergy GMR installed
S BPCERR=0
S X="GMRADPT" X ^%ZOSF("TEST") I '$T D Q:BPCERR
.S ^XTMP("BPCRXALG",JOB,1)=-1,^(2)="Allergy Package not Installed!"
.D KILL
.S BPCERR=1
.Q
;
S DFN=BPCPIEN D ^GMRADPT
;
;allergy info
S BPCERR=0
I $G(GMRAL)="" D Q:BPCERR
.S ^XTMP("BPCRXALG",JOB,1)=-1,^(2)="Patient has not been asked about allergies!"
.D KILL
.S BPCERR=1
.Q
;
S BPCERR=0
I $G(GMRAL)=0 D Q:BPCERR
.S ^XTMP("BPCRXALG",JOB,1)=-1,^(2)="Patient has no known allergies!"
.D KILL
.S BPCERR=1
.Q
;
S CTR=1,X="" F S X=$O(GMRAL(X)) Q:+X=0 D
.S Y=$P($G(GMRAL(X)),"^",2,8)
.S S=0,(S1,SIGN)="" F I=1:1 S S=$O(GMRAL(X,"S",S)) Q:+S=0 D
..S S1=$P($G(GMRAL(X,"S",S)),";",1)
..S:$L(S1) $P(SIGN,",",I)=S1
.S Y=Y_"^"_SIGN
.S CTR=CTR+1
.S Z=$P(Y,U,2),Z=$S(Z="D":"DRUG",Z="F":"FOOD",1:"OTHER"),$P(Y,U,2)=Z
.S Z=+$P(Y,U,3),Z=$S(Z=0:"UNVERIFIED",1:"VERIFIED"),$P(Y,U,3)=Z
.S Z=+$P(Y,U,4),Z=$S(Z=0:"ALLERGIC REACTION",1:"NON ALLERGIC REACTION"),$P(Y,U,4)=Z
.S Z=$P(Y,U,5),Z=$P(Z,";",1),$P(Y,U,5)=Z
.S Z=$P(Y,U,6),Z=$S(Z="D":"DRUG",Z="F":"FOOD",Z="DF":"DRUG/FOOD",Z="DFO":"DRUG/FOOD/OTHER",Z="DO":"DRUG/OTHER",Z="FO":"FOOD/OTHER",1:"OTHER"),$P(Y,U,6)=Z
.S Z=$P(Y,U,7),Z=$P(Z,";",1),$P(Y,U,7)=Z
.S ^XTMP("BPCRXALG",JOB,CTR)=Y
S ^XTMP("BPCRXALG",JOB,1)=CTR
Q
KILL ;kill variables
K APCDALVR,BPCPIEN,BPCTIEN,BPCLOC,BPCCAT,BPCCTR,BPCEPRV,BPCERR
K BPCGUI,BPCL,BPCLOC,BPCMOD,BPCMTYP,BPCVAL,BPCPIEN,BPCPROV,BPCRTN
K BPCTIEN,BPCTYPE,BPVVDT,BPCVFILE,BPCVSIT,BPCX
Q
;
BPCRXALG ; IHS/OIT/MJL - GUI RX ALLERGY DISPLAY ;
+1 ;;1.5;BPC;;MAY 26, 2005
+2 ;;
GETALG(BGUARRAY,BPCPIEN) ;EP CALL
+1 ; FROM REMOTE PROC: BPC RXALLERGY DATA
+2 ;BGUARRAY is return array
+3 ;BPCPIEN is patient IEN
+4 ;
EN ;ENTRY POINT FOR TESTING
+1 ;S BPCPIEN=12382
+2 SET JOB=$JOB
SET BPCGUI=1
SET XWBWRAP=1
+3 SET BGUARRAY="^XTMP(""BPCRXALG"","_$JOB_")"
+4 KILL @BGUARRAY
+5 ;
+6 ;check patient IEN
+7 SET BPCERR=0
+8 IF $GET(BPCPIEN)=""
SET ^XTMP("BPCRXALG",JOB,1)=-1
SET ^(2)="PATIENT IEN NOT SENT!"
DO KILL
SET BPCERR=1
QUIT
+9 ;
CALL ;CALLS GMRADPT TO CREATE DATA
+1 ;check if Allergy GMR installed
+2 SET BPCERR=0
+3 SET X="GMRADPT"
XECUTE ^%ZOSF("TEST")
IF '$TEST
Begin DoDot:1
+4 SET ^XTMP("BPCRXALG",JOB,1)=-1
SET ^(2)="Allergy Package not Installed!"
+5 DO KILL
+6 SET BPCERR=1
+7 QUIT
End DoDot:1
IF BPCERR
QUIT
+8 ;
+9 SET DFN=BPCPIEN
DO ^GMRADPT
+10 ;
+11 ;allergy info
+12 SET BPCERR=0
+13 IF $GET(GMRAL)=""
Begin DoDot:1
+14 SET ^XTMP("BPCRXALG",JOB,1)=-1
SET ^(2)="Patient has not been asked about allergies!"
+15 DO KILL
+16 SET BPCERR=1
+17 QUIT
End DoDot:1
IF BPCERR
QUIT
+18 ;
+19 SET BPCERR=0
+20 IF $GET(GMRAL)=0
Begin DoDot:1
+21 SET ^XTMP("BPCRXALG",JOB,1)=-1
SET ^(2)="Patient has no known allergies!"
+22 DO KILL
+23 SET BPCERR=1
+24 QUIT
End DoDot:1
IF BPCERR
QUIT
+25 ;
+26 SET CTR=1
SET X=""
FOR
SET X=$ORDER(GMRAL(X))
IF +X=0
QUIT
Begin DoDot:1
+27 SET Y=$PIECE($GET(GMRAL(X)),"^",2,8)
+28 SET S=0
SET (S1,SIGN)=""
FOR I=1:1
SET S=$ORDER(GMRAL(X,"S",S))
IF +S=0
QUIT
Begin DoDot:2
+29 SET S1=$PIECE($GET(GMRAL(X,"S",S)),";",1)
+30 IF $LENGTH(S1)
SET $PIECE(SIGN,",",I)=S1
End DoDot:2
+31 SET Y=Y_"^"_SIGN
+32 SET CTR=CTR+1
+33 SET Z=$PIECE(Y,U,2)
SET Z=$SELECT(Z="D":"DRUG",Z="F":"FOOD",1:"OTHER")
SET $PIECE(Y,U,2)=Z
+34 SET Z=+$PIECE(Y,U,3)
SET Z=$SELECT(Z=0:"UNVERIFIED",1:"VERIFIED")
SET $PIECE(Y,U,3)=Z
+35 SET Z=+$PIECE(Y,U,4)
SET Z=$SELECT(Z=0:"ALLERGIC REACTION",1:"NON ALLERGIC REACTION")
SET $PIECE(Y,U,4)=Z
+36 SET Z=$PIECE(Y,U,5)
SET Z=$PIECE(Z,";",1)
SET $PIECE(Y,U,5)=Z
+37 SET Z=$PIECE(Y,U,6)
SET Z=$SELECT(Z="D":"DRUG",Z="F":"FOOD",Z="DF":"DRUG/FOOD",Z="DFO":"DRUG/FOOD/OTHER",Z="DO":"DRUG/OTHER",Z="FO":"FOOD/OTHER",1:"OTHER")
SET $PIECE(Y,U,6)=Z
+38 SET Z=$PIECE(Y,U,7)
SET Z=$PIECE(Z,";",1)
SET $PIECE(Y,U,7)=Z
+39 SET ^XTMP("BPCRXALG",JOB,CTR)=Y
End DoDot:1
+40 SET ^XTMP("BPCRXALG",JOB,1)=CTR
+41 QUIT
KILL ;kill variables
+1 KILL APCDALVR,BPCPIEN,BPCTIEN,BPCLOC,BPCCAT,BPCCTR,BPCEPRV,BPCERR
+2 KILL BPCGUI,BPCL,BPCLOC,BPCMOD,BPCMTYP,BPCVAL,BPCPIEN,BPCPROV,BPCRTN
+3 KILL BPCTIEN,BPCTYPE,BPVVDT,BPCVFILE,BPCVSIT,BPCX
+4 QUIT
+5 ;
