- 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 ;
