AMHEYD2.m

AMHEYD2 ; IHS/CMI/LAB - PROCESS RECORD ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;

 ;

RECORD ;EP

 S (AMHE,AMHTX)="" K AMHRTYPE

 I '$D(^AMHREC(AMHR)) S AMHE="E026" Q

 I '$D(^AMHREC(AMHR,0)) S AMHTX="" Q

 S AMHREC=^AMHREC(AMHR,0)

 D RECORD^AMHEYC1

 I AMHE]"" Q

 S AMHTX=$$VREC(AMHR,"BH1")

 S AMH("ENC")=AMH("ENC")+1

 Q

VREC(AMHR,AMHRTYP) ;

 S AMHREC=^AMHREC(AMHR,0)

 S DFN=$P(^AMHREC(AMHR,0),U,8)

 S AMHSTG=$O(^AMHRCDST("B",AMHR,0))

 K AMHDRUG

 I AMHSTG D

 .S (X,C)=0 F  S X=$O(^AMHRCDST(AMHSTG,11,X)) Q:X'=+X  D

 ..S Y=$P(^AMHRCDST(AMHSTG,11,X,0),U)

 ..Q:'Y

 ..S Y=$P(^AMHTDRUG(Y,0),U,2)

 ..S C=C+1,AMHDRUG(C)=Y

 ..Q

 .Q

 NEW AMHRIEN S AMHRIEN=$O(^AMHRECD("B",AMHRTYP,0))

 I 'AMHRIEN Q ""

 NEW AMHY,AMHT S AMHY=0,AMHT="" F  S AMHY=$O(^AMHRECD(AMHRIEN,11,"B",AMHY)) Q:AMHY'=+AMHY  D

 .S X=""

 .NEW AMHZ S AMHZ=$O(^AMHRECD(AMHRIEN,11,"B",AMHY,0))

 .Q:'$D(^AMHRECD(AMHRIEN,11,AMHZ,1))

 .S X="" X ^AMHRECD(AMHRIEN,11,AMHZ,1)

 .S $P(AMHT,U,AMHY)=X

 .;S LORICNT=$G(LORICNT)+1,^LORITEST(LORICNT)=AMHR_"^"_$P(^AMHRECD(AMHRIEN,11,AMHZ,0),U,1)_"^"_$P(^AMHRECD(AMHRIEN,11,AMHZ,0),U,2)_"^"_X

 Q AMHT

AMHEYD2   ; IHS/CMI/LAB - PROCESS RECORD ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

 +3       ;

RECORD    ;EP

 +1        SET (AMHE,AMHTX)=""

           KILL AMHRTYPE

 +2        IF '$DATA(^AMHREC(AMHR))

               SET AMHE="E026"

               QUIT 

 +3        IF '$DATA(^AMHREC(AMHR,0))

               SET AMHTX=""

               QUIT 

 +4        SET AMHREC=^AMHREC(AMHR,0)

 +5        DO RECORD^AMHEYC1

 +6        IF AMHE]""

               QUIT 

 +7        SET AMHTX=$$VREC(AMHR,"BH1")

 +8        SET AMH("ENC")=AMH("ENC")+1

 +9        QUIT 

VREC(AMHR,AMHRTYP) ;

 +1        SET AMHREC=^AMHREC(AMHR,0)

 +2        SET DFN=$PIECE(^AMHREC(AMHR,0),U,8)

 +3        SET AMHSTG=$ORDER(^AMHRCDST("B",AMHR,0))

 +4        KILL AMHDRUG

 +5        IF AMHSTG

               Begin DoDot:1

 +6                SET (X,C)=0

                   FOR 

                       SET X=$ORDER(^AMHRCDST(AMHSTG,11,X))

                       IF X'=+X

                           QUIT 

                       Begin DoDot:2

 +7                        SET Y=$PIECE(^AMHRCDST(AMHSTG,11,X,0),U)

 +8                        IF 'Y

                               QUIT 

 +9                        SET Y=$PIECE(^AMHTDRUG(Y,0),U,2)

 +10                       SET C=C+1

                           SET AMHDRUG(C)=Y

 +11                       QUIT 

                       End DoDot:2

 +12               QUIT 

               End DoDot:1

 +13       NEW AMHRIEN

           SET AMHRIEN=$ORDER(^AMHRECD("B",AMHRTYP,0))

 +14       IF 'AMHRIEN

               QUIT ""

 +15       NEW AMHY,AMHT

           SET AMHY=0

           SET AMHT=""

           FOR 

               SET AMHY=$ORDER(^AMHRECD(AMHRIEN,11,"B",AMHY))

               IF AMHY'=+AMHY

                   QUIT 

               Begin DoDot:1

 +16               SET X=""

 +17               NEW AMHZ

                   SET AMHZ=$ORDER(^AMHRECD(AMHRIEN,11,"B",AMHY,0))

 +18               IF '$DATA(^AMHRECD(AMHRIEN,11,AMHZ,1))

                       QUIT 

 +19               SET X=""

                   XECUTE ^AMHRECD(AMHRIEN,11,AMHZ,1)

 +20               SET $PIECE(AMHT,U,AMHY)=X

 +21      ;S LORICNT=$G(LORICNT)+1,^LORITEST(LORICNT)=AMHR_"^"_$P(^AMHRECD(AMHRIEN,11,AMHZ,0),U,1)_"^"_$P(^AMHRECD(AMHRIEN,11,AMHZ,0),U,2)_"^"_X

               End DoDot:1

 +22       QUIT AMHT