AMERPRE1.m

AMERPRE1 ; IHS/OIT/SCR - PRE-INIT ROUTINE FOR ERS V3.0 patch 1 ; 

 ;;3.0;ER VISIT SYSTEM;**1**;FEB 23, 2009

EDITMETA ;

 ; REMOVE UNWANTED ENTRIES FROM ER METADATA ^AMER(2.2

 N AMERNUM,AMERIEN,AMERTAGS,AMERTAG,DA,DIK

 S AMERNUM=1,AMERIEN=0

 S AMERTAGS="CURRENT COMMUNITY^BENEFICIARY CLASS^DIAGNOSTIC CATEGORY^EMERGENCY TRANSPORT^FINAL CONDITION^DOA^TRIBE^ELIGIBILITY"

 F  S AMERTAG=$P(AMERTAGS,"^",AMERNUM) Q:AMERTAG=""  D

 .S AMERIEN=$O(^AMER(2.2,"B",AMERTAG,AMERIEN))

 .I AMERIEN'="" D

 ..S DIK="^AMER(2.2,"

 ..Q:AMERIEN<0

 ..S DA=AMERIEN

 ..D ^DIK

 ..D IX^DIK

 ..Q

 .S AMERNUM=AMERNUM+1,AMERIEN=0

 .Q

 Q

AMERPRE1  ; IHS/OIT/SCR - PRE-INIT ROUTINE FOR ERS V3.0 patch 1 ; 

 +1       ;;3.0;ER VISIT SYSTEM;**1**;FEB 23, 2009

EDITMETA  ;

 +1       ; REMOVE UNWANTED ENTRIES FROM ER METADATA ^AMER(2.2

 +2        NEW AMERNUM,AMERIEN,AMERTAGS,AMERTAG,DA,DIK

 +3        SET AMERNUM=1

           SET AMERIEN=0

 +4        SET AMERTAGS="CURRENT COMMUNITY^BENEFICIARY CLASS^DIAGNOSTIC CATEGORY^EMERGENCY TRANSPORT^FINAL CONDITION^DOA^TRIBE^ELIGIBILITY"

 +5        FOR 

               SET AMERTAG=$PIECE(AMERTAGS,"^",AMERNUM)

               IF AMERTAG=""

                   QUIT 

               Begin DoDot:1

 +6                SET AMERIEN=$ORDER(^AMER(2.2,"B",AMERTAG,AMERIEN))

 +7                IF AMERIEN'=""

                       Begin DoDot:2

 +8                        SET DIK="^AMER(2.2,"

 +9                        IF AMERIEN<0

                               QUIT 

 +10                       SET DA=AMERIEN

 +11                       DO ^DIK

 +12                       DO IX^DIK

 +13                       QUIT 

                       End DoDot:2

 +14               SET AMERNUM=AMERNUM+1

                   SET AMERIEN=0

 +15               QUIT 

               End DoDot:1

 +16       QUIT