GMRA1001.m

GMRA1001 ;IHS/MSC/PLS - Patch support;04-May-2011 09:45;MGH

 ;;4.0;;;;Build 5

ENV ;EP -

 Q

PRE ;EP -

 ;Loop through the allergy file and remove any bad cross-references to

 ;the drug file that are found there

 N IEN,FIELD,ALL,AIEN,FDA,X,Y

 S X="PSDRUG(""B""),"

 S Y="PSDRUG(""C""),"

 S IEN=0 F  S IEN=$O(^GMR(120.8,IEN)) Q:'+IEN  D

 .S FIELD=$P($G(^GMR(120.8,IEN,0)),U,3)

 .I $P(FIELD,";",2)=X!($P(FIELD,";",2)=Y) D

 ..S NUM=$P(FIELD,";",1)_";"_"PSDRUG("

 ..S AIEN=IEN_","

 ..S FDA(120.8,AIEN,1)=NUM

 ..D UPDATE^DIE(,"FDA","DIEN","ERR")

 Q

POST ;EP -

 D DATA

 Q

 ;

DATA ; Import Data

 N LP,NAM,F

 S F=120.82

 F LP=0:0 S LP=$O(@XPDGREF@("DATA",F,LP)) Q:'LP  D

 .S NAM=$P($G(@XPDGREF@("DATA",F,LP,0)),U)

 .I $$EXISTS(NAM) D

 ..K @XPDGREF@("DATA",F,LP)

 D DATAIN^DIFROMS(F,"","",XPDGREF),DIERR("** ERROR IN DATA FOR FILE # "_F_" **"):$D(DIERR)

 Q

DIERR(XPDI) N XPD

 D MSG^DIALOG("AE",.XPD) Q:'$D(XPD)

 D BMES^XPDUTL(XPDI),MES^XPDUTL(.XPD)

 Q

 ; Check existence of entry

EXISTS(NAM) ;EP -

 Q $O(^GMRD(120.82,"B",NAM,0))>0

 ;

PRETRAN ;EP -

 N FNAM,FILE

 S FILE=120.82

 S FNAM="GMR ALLERGIES"

 D FIA^DIFROMSU(FILE,"",FNAM,XPDGREF,"n^y^f^^y^^y^m^n","","",4.0)

 D DATAOUT^DIFROMS("","","",XPDGREF)

 Q

GMRA1001  ;IHS/MSC/PLS - Patch support;04-May-2011 09:45;MGH

 +1       ;;4.0;;;;Build 5

ENV       ;EP -

 +1        QUIT 

PRE       ;EP -

 +1       ;Loop through the allergy file and remove any bad cross-references to

 +2       ;the drug file that are found there

 +3        NEW IEN,FIELD,ALL,AIEN,FDA,X,Y

 +4        SET X="PSDRUG(""B""),"

 +5        SET Y="PSDRUG(""C""),"

 +6        SET IEN=0

           FOR 

               SET IEN=$ORDER(^GMR(120.8,IEN))

               IF '+IEN

                   QUIT 

               Begin DoDot:1

 +7                SET FIELD=$PIECE($GET(^GMR(120.8,IEN,0)),U,3)

 +8                IF $PIECE(FIELD,";",2)=X!($PIECE(FIELD,";",2)=Y)

                       Begin DoDot:2

 +9                        SET NUM=$PIECE(FIELD,";",1)_";"_"PSDRUG("

 +10                       SET AIEN=IEN_","

 +11                       SET FDA(120.8,AIEN,1)=NUM

 +12                       DO UPDATE^DIE(,"FDA","DIEN","ERR")

                       End DoDot:2

               End DoDot:1

 +13       QUIT 

POST      ;EP -

 +1        DO DATA

 +2        QUIT 

 +3       ;

DATA      ; Import Data

 +1        NEW LP,NAM,F

 +2        SET F=120.82

 +3        FOR LP=0:0

               SET LP=$ORDER(@XPDGREF@("DATA",F,LP))

               IF 'LP

                   QUIT 

               Begin DoDot:1

 +4                SET NAM=$PIECE($GET(@XPDGREF@("DATA",F,LP,0)),U)

 +5                IF $$EXISTS(NAM)

                       Begin DoDot:2

 +6                        KILL @XPDGREF@("DATA",F,LP)

                       End DoDot:2

               End DoDot:1

 +7        DO DATAIN^DIFROMS(F,"","",XPDGREF)

           IF $DATA(DIERR)

               DO DIERR("** ERROR IN DATA FOR FILE # "_F_" **")

 +8        QUIT 

DIERR(XPDI)  NEW XPD

 +1        DO MSG^DIALOG("AE",.XPD)

           IF '$DATA(XPD)

               QUIT 

 +2        DO BMES^XPDUTL(XPDI)

           DO MES^XPDUTL(.XPD)

 +3        QUIT 

 +4       ; Check existence of entry

EXISTS(NAM) ;EP -

 +1        QUIT $ORDER(^GMRD(120.82,"B",NAM,0))>0

 +2       ;

PRETRAN   ;EP -

 +1        NEW FNAM,FILE

 +2        SET FILE=120.82

 +3        SET FNAM="GMR ALLERGIES"

 +4        DO FIA^DIFROMSU(FILE,"",FNAM,XPDGREF,"n^y^f^^y^^y^m^n","","",4.0)

 +5        DO DATAOUT^DIFROMS("","","",XPDGREF)

 +6        QUIT