Routine: DGHTINAC

DGHTINAC ;ALB/JRC/JAM - Home Telehealth Patient Inactivation HL7;10 January 2005 ; 11/14/06 9:46am

 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20

;;

EN ;Main entry point

 ;Initiate variables

 N STOP,ARR,DGTYPE,DGDUZ,FLG

 N CNT,DGDFN,DGVEN,NODE,NODE1,MSGTYPE,INACTDT,IRECORD,INODE,DGEVNT

 N INAMSGID,ACKCODE,TINACTDT,DGVEN,DGCOOR,DGDATE,VENDOR,CHOICES

 N ARECORD,NUMBER,TMPNODE,ITRANS,INODE,DGMID,RESULT,GETOK,DIR,RECORD

 S ARR=$NA(HLA("HLS")),DGTYPE="I",DGDUZ=DUZ

 S STOP=0

 F  D  Q:STOP

 .K ^TMP("DGHT",$J),CHOICES

 .S (DGVEN,RECORD,CNT,FLG,ITRANS)=0

 .W !!

 .;Select patient

 .S DGDFN=$$GETPAT()

 .I 'DGDFN S STOP=1 Q

 .;Get active patient's home telehealth records

 .F  S DGVEN=$O(^DGHT(391.31,"APATVN",DGDFN,DGVEN)) Q:'DGVEN  D

 ..S ARECORD=$$LOCREC(DGDFN,DGVEN,"A")

 ..Q:'(ARECORD)

 ..;Get 0'th node of activation record and 0'th node of transaction

 ..S NODE=$G(^DGHT(391.31,$P(ARECORD,U,1),0))

 ..S NODE1=$G(^DGHT(391.31,+$P(ARECORD,U,1),"TRAN",+$P(ARECORD,U,2),0))

 ..Q:$P(NODE1,U,7)'="A"

 ..S IRECORD=$$LOCREC(DGDFN,DGVEN,"I")

 ..Q:'+IRECORD

 ..S MSGTYPE=$P($G(NODE1),U,4),INACTDT=$P($G(NODE),U,7)

 ..;Get Inactivation transaction node if exist

 ..S INODE=$G(^DGHT(391.31,+$P(IRECORD,U,1),"TRAN",+$P(IRECORD,U,2),0))

 ..S INAMSGID=$P(INODE,U,2),ACKCODE=$P(INODE,U,7),TINACTDT=$P(INODE,U,1)

 ..I $P($G(INODE),U,7)="A" Q

 ..;Increment counter

 ..S CNT=CNT+1

 ..;Store records in temporary global

..;

 ..;  ^TMP NODE  - Record # ^ Transaction # ^ patient ^ vendor ^

 ..;               trans date ^ coordinator ^ trans type ^ inactiva

 ..;               tio date ^ inact msg id ^ inact msg ack code ^

 ..;               trans inactivation date and time ^ inact record

..;

 ..S DGVEN=$P(NODE,U,3),DGCOOR=$P(NODE,U,5),DGDATE=$P(NODE,U,6)

 ..S ^TMP("DGHT",$J,CNT,$P(ARECORD,U,1))=ARECORD_U_DGDFN_U_DGVEN_U_DGDATE_U_DGCOOR_U_MSGTYPE_U_INACTDT_U_$G(INAMSGID)_U_$G(ACKCODE)_U_$G(TINACTDT)_U_$TR(IRECORD,U,"~")

 ..;If more than one record prepare CHOICES variable for DIR call

 ..S VENDOR=$$GET1^DIQ(4,$P(NODE,U,3),.01,"E")

 ..S CHOICES=$G(CHOICES)_CNT_":"_$TR($$FMTE^XLFDT(DGDATE,"1HM"),":","")_"   "_VENDOR_";"

 ..;If more than one active HTH record prompt user for selection

 .I CNT>1 D  Q:FLG

 ..;Resolve external value for PATIENT

 ..W !!,"Patient "_$$GET1^DIQ(2,DGDFN,.01,"E")_" has multiple  active records"

 ..K DIR,X,Y,DIRUT,DUOUT

 ..S DIR(0)="S^"_CHOICES

 ..S DIR("A")="Select Sign-up/Activation record to Inactivate"

 ..D ^DIR

 ..I $D(DIRUT)!$D(DUOUT) S FLG=1 Q

 ..S NUMBER=Y

 ..S RECORD=0,RECORD=$O(^TMP("DGHT",$J,NUMBER,RECORD))

 ..S TMPNODE=^TMP("DGHT",$J,NUMBER,RECORD),IRECORD=$P(TMPNODE,U,12)

 .;If there is only one record suppress choices

 .I CNT=1 D

 ..S NUMBER=CNT

 ..S RECORD=0,RECORD=$O(^TMP("DGHT",$J,NUMBER,RECORD))

 ..S TMPNODE=^TMP("DGHT",$J,CNT,RECORD),IRECORD=$P(TMPNODE,U,12)

 .;If no active records

 .I 'CNT D  Q:FLG

 ..W !

 ..W !,"************************************************************"

 ..W !,"*   THIS PATIENT HAS NO ACTIVE HOME TELEHEALTH  RECORDS     *"

 ..W !,"************************************************************"

 ..S FLG=1

 .;Display patient's record information to screen

 .W @IOF

 .W !!,"THE FOLLOWING PATIENT'S HOME TELEHEALTH RECORD WILL BE INACTIVATED"

 .W !!

 .D DSPREC^DGHTENR($P(TMPNODE,U,1,2))

 .;If patient's record was previously inactivated display information

 .I +$P(IRECORD,"~",2)'="" D

 ..W !,"Patient's inactivation was previously transmitted on:"

 ..W !!,?3,"Date & Time: ",?21,$$FMTE^XLFDT($P(TMPNODE,U,11),"2")

 ..W !,?3,"Message ID: ",?21,$P(TMPNODE,U,9)

 ..W !,?3,"Acknowledge Code: ",?21,$S($P(TMPNODE,U,10)="R":"Rejected",$P(TMPNODE,U,10)="A":"Accepted",1:"")

 ..W !!

 .;Prompt user for inactivation date

 .K DIR,X,Y,DIRUT,DUOUT

 .S DIR(0)="D^::ERTXS"

 .S DIR("A")="Enter Inactivation Date & Time"

 .S DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT())

 .D ^DIR

 .I $D(DIRUT)!$D(DUOUT) D EXIT Q

 .S DGEVNT=Y

 .;Get okay for tansmission

 .S GETOK=$$SNDMSG^DGHTENR(DGTYPE)

 .I 'GETOK W "  ...Patient record not transmitted." D EXIT Q

 .;Set variables and validate

 .S DGVEN=$P(TMPNODE,U,4),DGDATE=$P(TMPNODE,U,5)

 .S DGCOOR=$P(TMPNODE,U,6),TINACTDT=$P(TMPNODE,U,10)

 .;build message

 .W !!,"Generating message ..."

 .K @ARR

 .S RESULT=$$BLDHL7I^DGHTHL7(DGDFN,ARR)

 .I RESULT<0 D  Q

 ..W !,"** UNABLE TO BUILD MESSAGE **"

 ..W !,$P(RESULT,"^",2)

 ..K @ARR

 .I RESULT=0 D  Q

 ..W !,"** EMPTY MESSAGE BUILT **"

 ..K @ARR

 .;send message

 .W !,"Sending message ..."

 .S RESULT=$$SNDHL7^DGHTHL7(ARR,DGVEN,"DG HOME TELEHEALTH ADT-A03 SERVER")

 .I RESULT<0 D  Q

 ..W !,"** UNABLE TO SEND MESSAGE **"

 ..W !,$P(RESULT,"^",2)

 ..K @ARR

 .W !,"Sent using message ID ",+RESULT

 .S DGMID=$P(RESULT,U,1)

 .K @ARR

 .D FILE

 D EXIT

GETPAT()        ;Prompt user for patient

 ;Input : None

 ;Output: Pointer to PATIENT File, #2 (i.e. DFN)

 ;        0 on user quit

 N DIC,X,Y,DTOUT,DUOUT

 S DIC="^DPT(",DIC("A")="Patient: "

 S DIC(0)="AEQM"

 S DIC("S")="I $D(^DGHT(391.31,""APATVN"",+Y))"

 D ^DIC

 Q $S(+Y<0:0,1:+Y)

FILE ;Update Home Telehealth File Inactivation

 N DGHFDA,DGHERR,FLDS,DA

 ;Remove old inactivation entry in transaction subfile

 I +$P(IRECORD,"~",2) D

 .N DIK S DA(1)=+$P(IRECORD,"~",1),DA=+$P(IRECORD,"~",2)

 .S DIK="^DGHT(391.31,"_DA(1)_",""TRAN"","

 .D ^DIK

 ;Update subfile 391.317 Transaction

 K DGHFDA,DGHERR

 S DGHFDA(391.317,"+2,"_RECORD_",",.01)=DGEVNT

 S DGHFDA(391.317,"+2,"_RECORD_",",.02)=DGMID

 S DGHFDA(391.317,"+2,"_RECORD_",",.03)=DGDUZ

 S DGHFDA(391.317,"+2,"_RECORD_",",.04)=DGTYPE

 D UPDATE^DIE("","DGHFDA","","DGHERR")

 I $D(DGHERR) D

 .W !!!,"Problem encountered during record update "

 .W !!,"Contact IRM"_"  Error: "_$G(DGHERR("DIERR",1,"TEXT",1))

LOCREC(DFN,VENDOR,TYPE) ;Locate the appropriate record pointer(s) for processing

 ;Input : DFN    - Patient DFN

 ;        VENDOR - Vendor IEN

 ;        TYPE   - A for Activation/Sign-up  or I for Inactivation

 ;Output: Record IEN^transaction IEN (if available)

 ;   flag 1 = Patient record was located

 ;        0 = No record was located.

 ;If TYPE="A"  and record has inactivation date then nothing will be

 ;             returned, record is consider closed.

 ;   TYPE="I"  and transaction level record was accepted,then nothing

 ;             will be returned, record is consider closed.

 I ($G(DFN)="")!($G(VENDOR)="")!($G(TYPE)="") Q 0

 N IEN,IEN1,DGDAT,DGDAT1,FND,FND1

 S (IEN,FND,FND1)=0

 F  S IEN=$O(^DGHT(391.31,"APATVN",DFN,VENDOR,IEN)) Q:'IEN  D  I FND Q

 .S DGDAT=$G(^DGHT(391.31,IEN,0)) I DGDAT="" Q

 .Q:$P(DGDAT,"^",7)'=""

 .;I TYPE="A" Q:$P(DGDAT,"^",7)'=""

 .;I TYPE="I",$P(DGDAT,"^",7)="" S FND=IEN Q

 .S IEN1=0 F  S IEN1=$O(^DGHT(391.31,IEN,"TRAN",IEN1)) Q:'IEN1  D  Q:+FND1

 ..S DGDAT1=$G(^DGHT(391.31,IEN,"TRAN",IEN1,0)) Q:DGDAT1=""

 ..I $P(DGDAT1,"^",4)'=$E(TYPE) Q

 ..I TYPE="I",$P(DGDAT1,"^",7)="A" Q

 ..S FND1=IEN1

 .S FND=IEN_$S(IEN1:"^"_IEN1,1:"")

 Q FND

EXIT ;Kill array

 K ^TMP("DGHT",$J)

DGHTINAC  ;ALB/JRC/JAM - Home Telehealth Patient Inactivation HL7;10 January 2005 ; 11/14/06 9:46am

 +1       ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20

 +2       ;;

EN        ;Main entry point

 +1       ;Initiate variables

 +2        NEW STOP,ARR,DGTYPE,DGDUZ,FLG

 +3        NEW CNT,DGDFN,DGVEN,NODE,NODE1,MSGTYPE,INACTDT,IRECORD,INODE,DGEVNT

 +4        NEW INAMSGID,ACKCODE,TINACTDT,DGVEN,DGCOOR,DGDATE,VENDOR,CHOICES

 +5        NEW ARECORD,NUMBER,TMPNODE,ITRANS,INODE,DGMID,RESULT,GETOK,DIR,RECORD

 +6        SET ARR=$NAME(HLA("HLS"))

           SET DGTYPE="I"

           SET DGDUZ=DUZ

 +7        SET STOP=0

 +8        FOR

               Begin DoDot:1

 +9                KILL ^TMP("DGHT",$JOB),CHOICES

 +10               SET (DGVEN,RECORD,CNT,FLG,ITRANS)=0

 +11               WRITE !!

 +12      ;Select patient

 +13               SET DGDFN=$$GETPAT()

 +14               IF 'DGDFN

                       SET STOP=1

                       QUIT

 +15      ;Get active patient's home telehealth records

 +16               FOR

                       SET DGVEN=$ORDER(^DGHT(391.31,"APATVN",DGDFN,DGVEN))

                       IF 'DGVEN

                           QUIT

                       Begin DoDot:2

 +17                       SET ARECORD=$$LOCREC(DGDFN,DGVEN,"A")

 +18                       IF '(ARECORD)

                               QUIT

 +19      ;Get 0'th node of activation record and 0'th node of transaction

 +20                       SET NODE=$GET(^DGHT(391.31,$PIECE(ARECORD,U,1),0))

 +21                       SET NODE1=$GET(^DGHT(391.31,+$PIECE(ARECORD,U,1),"TRAN",+$PIECE(ARECORD,U,2),0))

 +22                       IF $PIECE(NODE1,U,7)'="A"

                               QUIT

 +23                       SET IRECORD=$$LOCREC(DGDFN,DGVEN,"I")

 +24                       IF '+IRECORD

                               QUIT

 +25                       SET MSGTYPE=$PIECE($GET(NODE1),U,4)

                           SET INACTDT=$PIECE($GET(NODE),U,7)

 +26      ;Get Inactivation transaction node if exist

 +27                       SET INODE=$GET(^DGHT(391.31,+$PIECE(IRECORD,U,1),"TRAN",+$PIECE(IRECORD,U,2),0))

 +28                       SET INAMSGID=$PIECE(INODE,U,2)

                           SET ACKCODE=$PIECE(INODE,U,7)

                           SET TINACTDT=$PIECE(INODE,U,1)

 +29                       IF $PIECE($GET(INODE),U,7)="A"

                               QUIT

 +30      ;Increment counter

 +31                       SET CNT=CNT+1

 +32      ;Store records in temporary global

 +33      ;

 +34      ;  ^TMP NODE  - Record # ^ Transaction # ^ patient ^ vendor ^

 +35      ;               trans date ^ coordinator ^ trans type ^ inactiva

 +36      ;               tio date ^ inact msg id ^ inact msg ack code ^

 +37      ;               trans inactivation date and time ^ inact record

 +38      ;

 +39                       SET DGVEN=$PIECE(NODE,U,3)

                           SET DGCOOR=$PIECE(NODE,U,5)

                           SET DGDATE=$PIECE(NODE,U,6)

 +40                       SET ^TMP("DGHT",$JOB,CNT,$PIECE(ARECORD,U,1))=ARECORD_U_DGDFN_U_DGVEN_U_DGDATE_U_DGCOOR_U_MSGTYPE_U_INACTDT_U_$GET(INAMSGID)_U_$GET(ACKCODE)_U_$GET(TINACTDT)_U_$TRANSLATE(IRECORD,U,"~")

 +41      ;If more than one record prepare CHOICES variable for DIR call

 +42                       SET VENDOR=$$GET1^DIQ(4,$PIECE(NODE,U,3),.01,"E")

 +43                       SET CHOICES=$GET(CHOICES)_CNT_":"_$TRANSLATE($$FMTE^XLFDT(DGDATE,"1HM"),":","")_"   "_VENDOR_";"

 +44      ;If more than one active HTH record prompt user for selection

                       End DoDot:2

 +45               IF CNT>1

                       Begin DoDot:2

 +46      ;Resolve external value for PATIENT

 +47                       WRITE !!,"Patient "_$$GET1^DIQ(2,DGDFN,.01,"E")_" has multiple  active records"

 +48                       KILL DIR,X,Y,DIRUT,DUOUT

 +49                       SET DIR(0)="S^"_CHOICES

 +50                       SET DIR("A")="Select Sign-up/Activation record to Inactivate"

 +51                       DO ^DIR

 +52                       IF $DATA(DIRUT)!$DATA(DUOUT)

                               SET FLG=1

                               QUIT

 +53                       SET NUMBER=Y

 +54                       SET RECORD=0

                           SET RECORD=$ORDER(^TMP("DGHT",$JOB,NUMBER,RECORD))

 +55                       SET TMPNODE=^TMP("DGHT",$JOB,NUMBER,RECORD)

                           SET IRECORD=$PIECE(TMPNODE,U,12)

                       End DoDot:2

                       IF FLG

                           QUIT

 +56      ;If there is only one record suppress choices

 +57               IF CNT=1

                       Begin DoDot:2

 +58                       SET NUMBER=CNT

 +59                       SET RECORD=0

                           SET RECORD=$ORDER(^TMP("DGHT",$JOB,NUMBER,RECORD))

 +60                       SET TMPNODE=^TMP("DGHT",$JOB,CNT,RECORD)

                           SET IRECORD=$PIECE(TMPNODE,U,12)

                       End DoDot:2

 +61      ;If no active records

 +62               IF 'CNT

                       Begin DoDot:2

 +63                       WRITE !

 +64                       WRITE !,"************************************************************"

 +65                       WRITE !,"*   THIS PATIENT HAS NO ACTIVE HOME TELEHEALTH  RECORDS     *"

 +66                       WRITE !,"************************************************************"

 +67                       SET FLG=1

                       End DoDot:2

                       IF FLG

                           QUIT

 +68      ;Display patient's record information to screen

 +69               WRITE @IOF

 +70               WRITE !!,"THE FOLLOWING PATIENT'S HOME TELEHEALTH RECORD WILL BE INACTIVATED"

 +71               WRITE !!

 +72               DO DSPREC^DGHTENR($PIECE(TMPNODE,U,1,2))

 +73      ;If patient's record was previously inactivated display information

 +74               IF +$PIECE(IRECORD,"~",2)'=""

                       Begin DoDot:2

 +75                       WRITE !,"Patient's inactivation was previously transmitted on:"

 +76                       WRITE !!,?3,"Date & Time: ",?21,$$FMTE^XLFDT($PIECE(TMPNODE,U,11),"2")

 +77                       WRITE !,?3,"Message ID: ",?21,$PIECE(TMPNODE,U,9)

 +78                       WRITE !,?3,"Acknowledge Code: ",?21,$SELECT($PIECE(TMPNODE,U,10)="R":"Rejected",$PIECE(TMPNODE,U,10)="A":"Accepted",1:"")

 +79                       WRITE !!

                       End DoDot:2

 +80      ;Prompt user for inactivation date

 +81               KILL DIR,X,Y,DIRUT,DUOUT

 +82               SET DIR(0)="D^::ERTXS"

 +83               SET DIR("A")="Enter Inactivation Date & Time"

 +84               SET DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT())

 +85               DO ^DIR

 +86               IF $DATA(DIRUT)!$DATA(DUOUT)

                       DO EXIT

                       QUIT

 +87               SET DGEVNT=Y

 +88      ;Get okay for tansmission

 +89               SET GETOK=$$SNDMSG^DGHTENR(DGTYPE)

 +90               IF 'GETOK

                       WRITE "  ...Patient record not transmitted."

                       DO EXIT

                       QUIT

 +91      ;Set variables and validate

 +92               SET DGVEN=$PIECE(TMPNODE,U,4)

                   SET DGDATE=$PIECE(TMPNODE,U,5)

 +93               SET DGCOOR=$PIECE(TMPNODE,U,6)

                   SET TINACTDT=$PIECE(TMPNODE,U,10)

 +94      ;build message

 +95               WRITE !!,"Generating message ..."

 +96               KILL @ARR

 +97               SET RESULT=$$BLDHL7I^DGHTHL7(DGDFN,ARR)

 +98               IF RESULT<0

                       Begin DoDot:2

 +99                       WRITE !,"** UNABLE TO BUILD MESSAGE **"

 +100                      WRITE !,$PIECE(RESULT,"^",2)

 +101                      KILL @ARR

                       End DoDot:2

                       QUIT

 +102              IF RESULT=0

                       Begin DoDot:2

 +103                      WRITE !,"** EMPTY MESSAGE BUILT **"

 +104                      KILL @ARR

                       End DoDot:2

                       QUIT

 +105     ;send message

 +106              WRITE !,"Sending message ..."

 +107              SET RESULT=$$SNDHL7^DGHTHL7(ARR,DGVEN,"DG HOME TELEHEALTH ADT-A03 SERVER")

 +108              IF RESULT<0

                       Begin DoDot:2

 +109                      WRITE !,"** UNABLE TO SEND MESSAGE **"

 +110                      WRITE !,$PIECE(RESULT,"^",2)

 +111                      KILL @ARR

                       End DoDot:2

                       QUIT

 +112              WRITE !,"Sent using message ID ",+RESULT

 +113              SET DGMID=$PIECE(RESULT,U,1)

 +114              KILL @ARR

 +115              DO FILE

               End DoDot:1

               IF STOP

                   QUIT

 +116      DO EXIT

 +117      QUIT

 +118     ;

GETPAT()  ;Prompt user for patient

 +1       ;Input : None

 +2       ;Output: Pointer to PATIENT File, #2 (i.e. DFN)

 +3       ;        0 on user quit

 +4        NEW DIC,X,Y,DTOUT,DUOUT

 +5        SET DIC="^DPT("

           SET DIC("A")="Patient: "

 +6        SET DIC(0)="AEQM"

 +7        SET DIC("S")="I $D(^DGHT(391.31,""APATVN"",+Y))"

 +8        DO ^DIC

 +9        QUIT $SELECT(+Y<0:0,1:+Y)

 +10      ;

FILE      ;Update Home Telehealth File Inactivation

 +1        NEW DGHFDA,DGHERR,FLDS,DA

 +2       ;Remove old inactivation entry in transaction subfile

 +3        IF +$PIECE(IRECORD,"~",2)

               Begin DoDot:1

 +4                NEW DIK

                   SET DA(1)=+$PIECE(IRECORD,"~",1)

                   SET DA=+$PIECE(IRECORD,"~",2)

 +5                SET DIK="^DGHT(391.31,"_DA(1)_",""TRAN"","

 +6                DO ^DIK

               End DoDot:1

 +7       ;Update subfile 391.317 Transaction

 +8        KILL DGHFDA,DGHERR

 +9        SET DGHFDA(391.317,"+2,"_RECORD_",",.01)=DGEVNT

 +10       SET DGHFDA(391.317,"+2,"_RECORD_",",.02)=DGMID

 +11       SET DGHFDA(391.317,"+2,"_RECORD_",",.03)=DGDUZ

 +12       SET DGHFDA(391.317,"+2,"_RECORD_",",.04)=DGTYPE

 +13       DO UPDATE^DIE("","DGHFDA","","DGHERR")

 +14       IF $DATA(DGHERR)

               Begin DoDot:1

 +15               WRITE !!!,"Problem encountered during record update "

 +16               WRITE !!,"Contact IRM"_"  Error: "_$GET(DGHERR("DIERR",1,"TEXT",1))

               End DoDot:1

 +17       QUIT

 +18      ;

LOCREC(DFN,VENDOR,TYPE) ;Locate the appropriate record pointer(s) for processing

 +1       ;Input : DFN    - Patient DFN

 +2       ;        VENDOR - Vendor IEN

 +3       ;        TYPE   - A for Activation/Sign-up  or I for Inactivation

 +4       ;Output: Record IEN^transaction IEN (if available)

 +5       ;   flag 1 = Patient record was located

 +6       ;        0 = No record was located.

 +7       ;

 +8       ;If TYPE="A"  and record has inactivation date then nothing will be

 +9       ;             returned, record is consider closed.

 +10      ;   TYPE="I"  and transaction level record was accepted,then nothing

 +11      ;             will be returned, record is consider closed.

 +12      ;

 +13       IF ($GET(DFN)="")!($GET(VENDOR)="")!($GET(TYPE)="")

               QUIT 0

 +14       NEW IEN,IEN1,DGDAT,DGDAT1,FND,FND1

 +15       SET (IEN,FND,FND1)=0

 +16       FOR

               SET IEN=$ORDER(^DGHT(391.31,"APATVN",DFN,VENDOR,IEN))

               IF 'IEN

                   QUIT

               Begin DoDot:1

 +17               SET DGDAT=$GET(^DGHT(391.31,IEN,0))

                   IF DGDAT=""

                       QUIT

 +18               IF $PIECE(DGDAT,"^",7)'=""

                       QUIT

 +19      ;I TYPE="A" Q:$P(DGDAT,"^",7)'=""

 +20      ;I TYPE="I",$P(DGDAT,"^",7)="" S FND=IEN Q

 +21               SET IEN1=0

FOR

                       SET IEN1=$ORDER(^DGHT(391.31,IEN,"TRAN",IEN1))

                       IF 'IEN1

                           QUIT

                       Begin DoDot:2

 +22                       SET DGDAT1=$GET(^DGHT(391.31,IEN,"TRAN",IEN1,0))

                           IF DGDAT1=""

                               QUIT

 +23                       IF $PIECE(DGDAT1,"^",4)'=$EXTRACT(TYPE)

                               QUIT

 +24                       IF TYPE="I"

                               IF $PIECE(DGDAT1,"^",7)="A"

                                   QUIT

 +25                       SET FND1=IEN1

                       End DoDot:2

                       IF +FND1

                           QUIT

 +26               SET FND=IEN_$SELECT(IEN1:"^"_IEN1,1:"")

               End DoDot:1

               IF FND

                   QUIT

 +27       QUIT FND

 +28      ;

EXIT      ;Kill array

 +1        KILL ^TMP("DGHT",$JOB)

 +2        QUIT

DGHTINAC.m