| 1 | FHWGMR ; HISC/NCA - Signed Reaction Event Filer ;2/16/96 11:37
|
|---|
| 2 | ;;5.5;DIETETICS;**8**;Jan 28, 2005;Build 28
|
|---|
| 3 | EN1 ; File Entered Signed Reaction
|
|---|
| 4 | Q:+$$VERSION^XPDUTL("GMRA")'=4
|
|---|
| 5 | S FLG=1 D CHK G:'FLG KIL
|
|---|
| 6 | S EVT="M^O^^"_"Allergy - "_ALG D FIL
|
|---|
| 7 | I FHGMRN'="" D UPDFP
|
|---|
| 8 | G KIL
|
|---|
| 9 | CAN ; File Cancelled/Entered in Error Allergy
|
|---|
| 10 | S FLG=1 D CHK G:'FLG KIL
|
|---|
| 11 | S EVT="M^O^^"_"Allergy - "_ALG_" Cancelled" D FIL
|
|---|
| 12 | I FHGMRN'="" D CANFP
|
|---|
| 13 | G KIL
|
|---|
| 14 | FIL ; File Event
|
|---|
| 15 | D ^FHORX
|
|---|
| 16 | Q
|
|---|
| 17 | KIL K %,%H,%I,ADM,ALG,COM,DFN,FHSTR,FHTYP,FHWRD,FLG,FHALGN,FHGMRN,FHFPN,FHFPIEN,X Q
|
|---|
| 18 | CHK ; Check Validity of Data Passed
|
|---|
| 19 | I 'GMRAPA!($G(GMRAPA(0))="") G ERR
|
|---|
| 20 | S FHSTR=$G(GMRAPA(0)),DFN=+FHSTR G:'DFN ERR
|
|---|
| 21 | S FHALGN=$P(FHSTR,U,3)
|
|---|
| 22 | S FHGMRN="" I $P(FHALGN,";",2)="GMRD(120.82," S FHGMRN=$P(FHALGN,";",1)
|
|---|
| 23 | S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" G ERR
|
|---|
| 24 | S ALG=$P(FHSTR,"^",2) G:ALG="" ERR
|
|---|
| 25 | G:'$D(^FHPT(FHDFN)) ERR S FHWRD=$G(^DPT(DFN,.1)) ;G:FHWRD="" ERR
|
|---|
| 26 | S ADM="" I FHWRD'="" S ADM=$G(^DPT("CN",FHWRD,DFN)) ;G:ADM<1 ERR
|
|---|
| 27 | G:'$P(FHSTR,"^",12) ERR
|
|---|
| 28 | S FHTYP=$P(FHSTR,"^",20) G:FHTYP'["F" ERR
|
|---|
| 29 | Q
|
|---|
| 30 | UPDFP ;Automatically add FP's corresponding to the Allergy
|
|---|
| 31 | D ^FHSELA2
|
|---|
| 32 | UPDFP1 I $O(^FH(115.2,"C",FHGMRN,""))="" D MISSFP Q ;No Corr FP for FHGMRN
|
|---|
| 33 | F FHFPN=0:0 S FHFPN=$O(^FH(115.2,"C",FHGMRN,FHFPN)) Q:FHFPN'>0 D ADD
|
|---|
| 34 | Q
|
|---|
| 35 | ADD ;Add the FP(s) to the patient record
|
|---|
| 36 | I $O(^FHPT(FHDFN,"P","B",FHFPN,"")) Q ;pt already has the FP
|
|---|
| 37 | I $G(^FH(115.2,FHFPN,"I"))="Y" Q ;don't assign INACTIVE FP's
|
|---|
| 38 | S Y=FHFPN K DIC,DO S DA(1)=FHDFN,DIC="^FHPT("_DA(1)_",""P"","
|
|---|
| 39 | S DIC(0)="L",DIC("P")=$P(^DD(115,10,0),U,2),X=+Y
|
|---|
| 40 | D FILE^DICN I Y=-1 Q
|
|---|
| 41 | K DIE S DA=+Y,DA(1)=FHDFN,DIE="^FHPT("_DA(1)_",""P"","
|
|---|
| 42 | S DR="1////^S X=""BNE""" D ^DIE
|
|---|
| 43 | S COM="Add "_$P($G(^FH(115.2,FHFPN,0)),U,1)_" (BNE) (D)"
|
|---|
| 44 | S EVT="P^O^^"_COM D ^FHORX
|
|---|
| 45 | Q
|
|---|
| 46 | MISSFP ;
|
|---|
| 47 | I '$D(^GMRD(120.82,FHGMRN,0)) Q ;bad pointer/entry
|
|---|
| 48 | S FHANAME=$P($G(^GMRD(120.82,FHGMRN,0)),U,1)
|
|---|
| 49 | S FHPTNM=$P($G(^DPT(DFN,0)),U,1)
|
|---|
| 50 | S FHRR="" F S FHRR=$O(^TMP($J,"FHALG",FHRR)) Q:FHRR="" S FHRRNM=$P(^TMP($J,"FHALG",FHRR),";",2,99) D
|
|---|
| 51 | .S FHZ=0 F S FHZ=FHZ+1,FHANMZZ=$P(FHRRNM,";",FHZ) Q:FHANMZZ="" D
|
|---|
| 52 | ..I FHANMZZ=FHANAME S ^TMP($J,"FHMISS",FHRR,FHPTNM)=FHANAME
|
|---|
| 53 | Q
|
|---|
| 54 | CANFP ;Automatically cancel FP's corresponding to Allergy Entered in Error
|
|---|
| 55 | I $O(^FH(115.2,"C",FHGMRN,""))="" Q ;No Corr FP for this GMRA Allergy
|
|---|
| 56 | F FHFPN=0:0 S FHFPN=$O(^FH(115.2,"C",FHGMRN,FHFPN)) Q:FHFPN'>0 D REM
|
|---|
| 57 | Q
|
|---|
| 58 | REM ;Remove the FP(s) from the patient record
|
|---|
| 59 | I '$O(^FHPT(FHDFN,"P","B",FHFPN,"")) Q ;pt does not have the FP
|
|---|
| 60 | S FHFPIEN=$O(^FHPT(FHDFN,"P","B",FHFPN,""))
|
|---|
| 61 | S DA(1)=FHDFN,DA=FHFPIEN,DIK="^FHPT("_DA(1)_",""P""," D ^DIK
|
|---|
| 62 | S COM="Del "_$P($G(^FH(115.2,FHFPN,0)),U,1)_" (BNE) (D)"
|
|---|
| 63 | S EVT="P^O^^"_COM D ^FHORX
|
|---|
| 64 | Q
|
|---|
| 65 | ERR S FLG=0 Q
|
|---|
