BADEEVNT.m

BADEEVNT ;IHS/MSC/MGH - Dentrix HL7 interface  ;30-Jun-2009 15:26;PLS

 ;;1.0;DENTAL/EDR INTERFACE;**1**;AUG 22, 2011

 ;; Modified - IHS/MSC/AMF - 11/23/10 - Updated Out of Order, alerts, removed H 2

 ;; Modified - IHS/MSC/VAC 9/2010 check for patient # in AUPNPAT

 Q

TLOADPT ;EP Taskman call to start patient load

 N STOP,ZTDTH,ZTIO,ZTDESC,ZTRTN,ZTSAVE,ZTPRI,ZTSK

 ;Make sure its not already running

 S STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")

 ;Its already running and shouldn't be restarted

 I STOP="NO" D  H 3 Q

 .W !,"Process is already running",!

 I $$GET^XPAR("ALL","BADE EDR LAST DFN") D  H 3 Q

 .W !,"Upload process has already begun. Please use Restart option.",!

 S ZTIO=""

 S ZTPRI=1

 S ZTDESC="Load Patient Data to EDR"

 S ZTRTN="LOADPT^BADEEVNT"

 S ZTSAVE("DUZ")=""

 D ^%ZTLOAD

 I $G(ZTSK) D

 .D EN^XPAR("SYS","BADE EDR LOAD TSK",1,ZTSK)

 .W !,"Task number "_ZTSK H 2

 Q

LOADPT ;EP Load all patient's data

 N DFN,CNT,CNTCHK,DATA,TOTAL,STOP,THROTTLE,BADELOAD

 ;Make sure the stop parameter is NO

 D EN^XPAR("SYS","BADE EDR PAUSE PATIENT LOAD",1,"NO")

 ;Make sure the Pt DFN is set to null

 S DFN=$$GET^XPAR("ALL","BADE EDR LAST DFN")

 ;Check to see how many patients to process before throttling

 S CNTCHK=$$GET^XPAR("ALL","BADE EDR THROTTLE CT")

 ;Loop through the patients and send data

LOOP S DFN=$S(DFN>0:DFN,1:0),CNT=0,STOP="NO",TOTAL=0

 F  S DFN=$O(^DPT(DFN)) Q:+DFN'>0!(STOP="YES")  D

 .K PATNO

 .S PATNO=$P($G(^AUPNPAT(DFN,0)),"^",1)  ; IHS/MSC/VAC 9/2010 make sure patient # exists

 .Q:PATNO'=DFN

 .S PATNO=$D(^AUPNPAT(DFN,41))

 .Q:PATNO=""

 .S CNT=CNT+1

 .S BADELOAD=1

 .D A28^BADEEVNT(DFN)

 .K BADELOAD

 .;Set IEN into the DFN parameter

 .D EN^XPAR("SYS","BADE EDR LAST DFN",1,"`"_DFN)

 .;Add to total count

 .S TOTAL=TOTAL+1

 .D EN^XPAR("SYS","BADE EDR TOTAL PROCESSED",1,TOTAL)

 .;Check to see if we should stop

 .S STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")

 .Q:STOP="YES"

 .;If count=check throttle parameter

 .I CNT=CNTCHK D

 ..S THROTTLE=$$GET^XPAR("ALL","BADE EDR PT THROTTLE")

 ..S CNTCHK=$$GET^XPAR("ALL","BADE EDR THROTTLE CT")

 ..I THROTTLE>0 H THROTTLE

 ..S CNT=0

 ;Finish up by resetting the pt parameter to null and the stop paramater to YES

 I STOP="NO" D

 .D EN^XPAR("SYS","BADE EDR PAUSE PATIENT LOAD",1,"YES")

 .D EN^XPAR("SYS","BADE EDR LOAD TSK",1,"Upload complete")

 .D COMPLETE

 Q

TRESTRT ;EP Taskman call to restart patient load

 N STOP,ZTDTH,ZTIO,ZTDESC,ZTRTN,ZTSAVE,ZTPRI,ZTSK

 ;Make sure its not already running

 S STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")

 ;Its already running and shouldn't be restarted

 I STOP="NO" W !,"Process is already running",!!! H 3 Q

 S ZTIO=""

 S ZTPRI=1

 S ZTDESC="Load Patient Data to EDR"

 S ZTRTN="RESTPT^BADEEVNT"

 S ZTSAVE("DUZ")=""

 D ^%ZTLOAD

 I $G(ZTSK) D

 .D EN^XPAR("SYS","BADE EDR LOAD TSK",,ZTSK)

 .W !,"Task number "_ZTSK H 2

 Q

RESTPT ;EP Restart the patient load

 N DFN,CNT,CNTCHK,TOTAL,DATA,STOP

 ;Get the last used DFN from the parameter

 S DFN=$$GET^XPAR("ALL","BADE EDR LAST DFN")

 ;Set the stop parameter to NO

 D EN^XPAR("SYS","BADE EDR PAUSE PATIENT LOAD",,0)

 ;Get the total count

 S TOTAL=$$GET^XPAR("ALL","BADE EDR TOTAL PROCESSED")

 S CNTCHK=$$GET^XPAR("ALL","BADE EDR THROTTLE CT")

 ;Task off the job of restarting

LOOP2 S CNT=0,STOP="NO"

 S DFN=$S(DFN>0:DFN,1:0)

 F  S DFN=$O(^DPT(DFN)) Q:+DFN'>0!(STOP="YES")  D

 .K PATNO

 .S PATNO=$P($G(^AUPNPAT(DFN,0)),"^",1)  ; IHS/MSC/VAC 9/2010 make sure patient # exists

 .Q:PATNO'=DFN

 .S PATNO=$D(^AUPNPAT(DFN,41))

 .Q:PATNO=""

 .S CNT=CNT+1

 .S BADELOAD=1

 .D A28^BADEEVNT(DFN)

 .K BADELOAD

 .;Set IEN into the DFN parameter

 .D EN^XPAR("SYS","BADE EDR LAST DFN",1,"`"_DFN)

 .;Add to total count

 .S TOTAL=TOTAL+1

 .D EN^XPAR("SYS","BADE EDR TOTAL PROCESSED",1,TOTAL)

 .;See if we should stop

 .S STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")

 .Q:STOP="YES"

 .;if count=parameter value check throttle parameter

 .I CNT=CNTCHK D

 ..S THROTTLE=$$GET^XPAR("ALL","BADE EDR PT THROTTLE")

 ..S CNTCHK=$$GET^XPAR("ALL","BADE EDR THROTTLE CT")

 ..I THROTTLE>0 H THROTTLE

 ..S CNT=0

 ;Finish up by resetting the pt parameter to null and the stop parameter to YES

 I STOP="NO" D

 .D EN^XPAR("SYS","BADE EDR PAUSE PATIENT LOAD",1,1)

 .D EN^XPAR("SYS","BADE EDR LOAD TSK",1,"Upload complete")

 .D COMPLETE

 Q

 ; IHS/MSC/AMF 10/2010 modified to mark all provider upload options complete

COMPLETE ;Mark options out of order

 N MSG,MENU,I

 S MENU(1)="BADE EDR UPLOAD ALL PATIENTS"

 S MENU(2)="BADE EDR RESTART PAT UPLOAD"

 S MENU(3)="BADE EDR PAUSE PATIENT LOAD"

 S MENU(4)="BADE EDR PT THROTTLE"

 S MENU(5)="BADE EDR THROTTLE CT"

 F I=1:1:5 D

 .N DA,DIE,DR

 .S MSG="Upload completed"

 .S DA=$O(^DIC(19,"B",MENU(I),""))

 .I DA'=""  D

 ..S DIE="^DIC(19,",DR="2///^S X=MSG"

 ..D ^DIE

 ; Enable event protocols

 D EDPROT^BADEUTIL("BADE PATIENT A28")

 D EDPROT^BADEUTIL("BADE PATIENT A31")

 Q

SENDA28 ;Send one A28 message

 N ERR,DIC,DT,DFN,Y

 S DIC=2,DIC("A")=" Select Patient:  ",DIC(0)="AEQMZ",DT=$$DT^XLFDT D ^DIC I +Y>0 D

 .S DFN=+Y

 .D A28(DFN)

 .I '$D(ERR) W !,"Message was sent"

 .E  W !,"Unable to send HL7 message"

  S DIR(0)="EA",DIR("?")="",DIR("A")="Press ENTER to continue..." D ^DIR K DIR ;IHS/MSC/AMF 11/23/10 Remove H 2

 Q

SENDA31 ;Send one A31 message

 N ERR,DIC,DT,DFN,BADERR,Y

 S DIC=2,DIC("A")=" Select Patient:  ",DIC(0)="AEQMZ",DT=$$DT^XLFDT D ^DIC I +Y>0 D

 .S DFN=+Y

 .D A31(DFN)

 .I '$D(ERR) W !,"Message was sent"

 .E  W !,"Unable to send HL7 message"

  S DIR(0)="EA",DIR("?")="",DIR("A")="Press ENTER to continue..." D ^DIR K DIR W ! ;IHS/MSC/AMF 11/23/10 Remove H 2

 Q

A28(DFN) ;EP Create and send one A28 message

 N EVNTTYPE,DOD

 S EVNTTYPE="A28"

 ;If patient has been merged, send the merged DFN

 Q:$D(^DPT(DFN,-9))

 I '$D(^DPT(DFN,0)) S ERR="No zero node for patient.  Cannot send A28." D NOTIF^BADEHL1(DFN,ERR) Q  ;IHS/MSC/AMF 11/23/10  descriptive alert

 ;Patient must be alive

 S DOD=$P($G(^DPT(DFN,.35)),U,1)

 I DOD="" D NEWMSG^BADEHL1(DFN,EVNTTYPE)

 Q

A31(DFN) ;EP Create and send one A31 message

 N EVNTTYPE,DOD

 S EVNTTYPE="A31"

 I '$D(^DPT(DFN,0)) S ERR="No zero node for patient.  Cannot send A31." D NOTIF^BADEHL1(DFN,ERR) Q  ;IHS/MSC/AMF 11/23/10  descriptive alert

 ;Don't send if patient is deceased

 ;S DOD=$P($G(^DPT(DFN,.35)),U,1)

 ;I DOD=""

 D NEWMSG^BADEHL1(DFN,EVNTTYPE)

 Q

MSA ;EP

 N MSA,HLST

 D SET(.ARY,"MSA",0)

 D SET(.ARY,"AA",1)

 D SET(.ARY,"TODO-MSGID",2)

 D SET(.ARY,"Transaction Successful",3)

 D SET(.ARY,"todo-010",4)

 S MSA=$$ADDSEG^HLOAPI(.HLST,.ARY)

 Q

SET(ARY,V,F,C,S,R) ;EP

 D SET^HLOAPI(.ARY,.V,.F,.C,.S,.R)

 Q

BADEEVNT  ;IHS/MSC/MGH - Dentrix HL7 interface  ;30-Jun-2009 15:26;PLS

 +1       ;;1.0;DENTAL/EDR INTERFACE;**1**;AUG 22, 2011

 +2       ;; Modified - IHS/MSC/AMF - 11/23/10 - Updated Out of Order, alerts, removed H 2

 +3       ;; Modified - IHS/MSC/VAC 9/2010 check for patient # in AUPNPAT

 +4        QUIT 

TLOADPT   ;EP Taskman call to start patient load

 +1        NEW STOP,ZTDTH,ZTIO,ZTDESC,ZTRTN,ZTSAVE,ZTPRI,ZTSK

 +2       ;Make sure its not already running

 +3        SET STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")

 +4       ;Its already running and shouldn't be restarted

 +5        IF STOP="NO"

               Begin DoDot:1

 +6                WRITE !,"Process is already running",!

               End DoDot:1

               HANG 3

               QUIT 

 +7        IF $$GET^XPAR("ALL","BADE EDR LAST DFN")

               Begin DoDot:1

 +8                WRITE !,"Upload process has already begun. Please use Restart option.",!

               End DoDot:1

               HANG 3

               QUIT 

 +9        SET ZTIO=""

 +10       SET ZTPRI=1

 +11       SET ZTDESC="Load Patient Data to EDR"

 +12       SET ZTRTN="LOADPT^BADEEVNT"

 +13       SET ZTSAVE("DUZ")=""

 +14       DO ^%ZTLOAD

 +15       IF $GET(ZTSK)

               Begin DoDot:1

 +16               DO EN^XPAR("SYS","BADE EDR LOAD TSK",1,ZTSK)

 +17               WRITE !,"Task number "_ZTSK

                   HANG 2

               End DoDot:1

 +18       QUIT 

LOADPT    ;EP Load all patient's data

 +1        NEW DFN,CNT,CNTCHK,DATA,TOTAL,STOP,THROTTLE,BADELOAD

 +2       ;Make sure the stop parameter is NO

 +3        DO EN^XPAR("SYS","BADE EDR PAUSE PATIENT LOAD",1,"NO")

 +4       ;Make sure the Pt DFN is set to null

 +5        SET DFN=$$GET^XPAR("ALL","BADE EDR LAST DFN")

 +6       ;Check to see how many patients to process before throttling

 +7        SET CNTCHK=$$GET^XPAR("ALL","BADE EDR THROTTLE CT")

 +8       ;Loop through the patients and send data

LOOP       SET DFN=$SELECT(DFN>0:DFN,1:0)

           SET CNT=0

           SET STOP="NO"

           SET TOTAL=0

 +1        FOR 

               SET DFN=$ORDER(^DPT(DFN))

               IF +DFN'>0!(STOP="YES")

                   QUIT 

               Begin DoDot:1

 +2                KILL PATNO

 +3       ; IHS/MSC/VAC 9/2010 make sure patient # exists

                   SET PATNO=$PIECE($GET(^AUPNPAT(DFN,0)),"^",1)

 +4                IF PATNO'=DFN

                       QUIT 

 +5                SET PATNO=$DATA(^AUPNPAT(DFN,41))

 +6                IF PATNO=""

                       QUIT 

 +7                SET CNT=CNT+1

 +8                SET BADELOAD=1

 +9                DO A28^BADEEVNT(DFN)

 +10               KILL BADELOAD

 +11      ;Set IEN into the DFN parameter

 +12               DO EN^XPAR("SYS","BADE EDR LAST DFN",1,"`"_DFN)

 +13      ;Add to total count

 +14               SET TOTAL=TOTAL+1

 +15               DO EN^XPAR("SYS","BADE EDR TOTAL PROCESSED",1,TOTAL)

 +16      ;Check to see if we should stop

 +17               SET STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")

 +18               IF STOP="YES"

                       QUIT 

 +19      ;If count=check throttle parameter

 +20               IF CNT=CNTCHK

                       Begin DoDot:2

 +21                       SET THROTTLE=$$GET^XPAR("ALL","BADE EDR PT THROTTLE")

 +22                       SET CNTCHK=$$GET^XPAR("ALL","BADE EDR THROTTLE CT")

 +23                       IF THROTTLE>0

                               HANG THROTTLE

 +24                       SET CNT=0

                       End DoDot:2

               End DoDot:1

 +25      ;Finish up by resetting the pt parameter to null and the stop paramater to YES

 +26       IF STOP="NO"

               Begin DoDot:1

 +27               DO EN^XPAR("SYS","BADE EDR PAUSE PATIENT LOAD",1,"YES")

 +28               DO EN^XPAR("SYS","BADE EDR LOAD TSK",1,"Upload complete")

 +29               DO COMPLETE

               End DoDot:1

 +30       QUIT 

TRESTRT   ;EP Taskman call to restart patient load

 +1        NEW STOP,ZTDTH,ZTIO,ZTDESC,ZTRTN,ZTSAVE,ZTPRI,ZTSK

 +2       ;Make sure its not already running

 +3        SET STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")

 +4       ;Its already running and shouldn't be restarted

 +5        IF STOP="NO"

               WRITE !,"Process is already running",!!!

               HANG 3

               QUIT 

 +6        SET ZTIO=""

 +7        SET ZTPRI=1

 +8        SET ZTDESC="Load Patient Data to EDR"

 +9        SET ZTRTN="RESTPT^BADEEVNT"

 +10       SET ZTSAVE("DUZ")=""

 +11       DO ^%ZTLOAD

 +12       IF $GET(ZTSK)

               Begin DoDot:1

 +13               DO EN^XPAR("SYS","BADE EDR LOAD TSK",,ZTSK)

 +14               WRITE !,"Task number "_ZTSK

                   HANG 2

               End DoDot:1

 +15       QUIT 

RESTPT    ;EP Restart the patient load

 +1        NEW DFN,CNT,CNTCHK,TOTAL,DATA,STOP

 +2       ;Get the last used DFN from the parameter

 +3        SET DFN=$$GET^XPAR("ALL","BADE EDR LAST DFN")

 +4       ;Set the stop parameter to NO

 +5        DO EN^XPAR("SYS","BADE EDR PAUSE PATIENT LOAD",,0)

 +6       ;Get the total count

 +7        SET TOTAL=$$GET^XPAR("ALL","BADE EDR TOTAL PROCESSED")

 +8        SET CNTCHK=$$GET^XPAR("ALL","BADE EDR THROTTLE CT")

 +9       ;Task off the job of restarting

LOOP2      SET CNT=0

           SET STOP="NO"

 +1        SET DFN=$SELECT(DFN>0:DFN,1:0)

 +2        FOR 

               SET DFN=$ORDER(^DPT(DFN))

               IF +DFN'>0!(STOP="YES")

                   QUIT 

               Begin DoDot:1

 +3                KILL PATNO

 +4       ; IHS/MSC/VAC 9/2010 make sure patient # exists

                   SET PATNO=$PIECE($GET(^AUPNPAT(DFN,0)),"^",1)

 +5                IF PATNO'=DFN

                       QUIT 

 +6                SET PATNO=$DATA(^AUPNPAT(DFN,41))

 +7                IF PATNO=""

                       QUIT 

 +8                SET CNT=CNT+1

 +9                SET BADELOAD=1

 +10               DO A28^BADEEVNT(DFN)

 +11               KILL BADELOAD

 +12      ;Set IEN into the DFN parameter

 +13               DO EN^XPAR("SYS","BADE EDR LAST DFN",1,"`"_DFN)

 +14      ;Add to total count

 +15               SET TOTAL=TOTAL+1

 +16               DO EN^XPAR("SYS","BADE EDR TOTAL PROCESSED",1,TOTAL)

 +17      ;See if we should stop

 +18               SET STOP=$$GET^XPAR("ALL","BADE EDR PAUSE PATIENT LOAD",1,"E")

 +19               IF STOP="YES"

                       QUIT 

 +20      ;if count=parameter value check throttle parameter

 +21               IF CNT=CNTCHK

                       Begin DoDot:2

 +22                       SET THROTTLE=$$GET^XPAR("ALL","BADE EDR PT THROTTLE")

 +23                       SET CNTCHK=$$GET^XPAR("ALL","BADE EDR THROTTLE CT")

 +24                       IF THROTTLE>0

                               HANG THROTTLE

 +25                       SET CNT=0

                       End DoDot:2

               End DoDot:1

 +26      ;Finish up by resetting the pt parameter to null and the stop parameter to YES

 +27       IF STOP="NO"

               Begin DoDot:1

 +28               DO EN^XPAR("SYS","BADE EDR PAUSE PATIENT LOAD",1,1)

 +29               DO EN^XPAR("SYS","BADE EDR LOAD TSK",1,"Upload complete")

 +30               DO COMPLETE

               End DoDot:1

 +31       QUIT 

 +32      ; IHS/MSC/AMF 10/2010 modified to mark all provider upload options complete

COMPLETE  ;Mark options out of order

 +1        NEW MSG,MENU,I

 +2        SET MENU(1)="BADE EDR UPLOAD ALL PATIENTS"

 +3        SET MENU(2)="BADE EDR RESTART PAT UPLOAD"

 +4        SET MENU(3)="BADE EDR PAUSE PATIENT LOAD"

 +5        SET MENU(4)="BADE EDR PT THROTTLE"

 +6        SET MENU(5)="BADE EDR THROTTLE CT"

 +7        FOR I=1:1:5

               Begin DoDot:1

 +8                NEW DA,DIE,DR

 +9                SET MSG="Upload completed"

 +10               SET DA=$ORDER(^DIC(19,"B",MENU(I),""))

 +11               IF DA'=""

                       Begin DoDot:2

 +12                       SET DIE="^DIC(19,"

                           SET DR="2///^S X=MSG"

 +13                       DO ^DIE

                       End DoDot:2

               End DoDot:1

 +14      ; Enable event protocols

 +15       DO EDPROT^BADEUTIL("BADE PATIENT A28")

 +16       DO EDPROT^BADEUTIL("BADE PATIENT A31")

 +17       QUIT 

SENDA28   ;Send one A28 message

 +1        NEW ERR,DIC,DT,DFN,Y

 +2        SET DIC=2

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

           SET DIC(0)="AEQMZ"

           SET DT=$$DT^XLFDT

           DO ^DIC

           IF +Y>0

               Begin DoDot:1

 +3                SET DFN=+Y

 +4                DO A28(DFN)

 +5                IF '$DATA(ERR)

                       WRITE !,"Message was sent"

 +6               IF '$TEST

                       WRITE !,"Unable to send HL7 message"

               End DoDot:1

 +7       ;IHS/MSC/AMF 11/23/10 Remove H 2

           SET DIR(0)="EA"

           SET DIR("?")=""

           SET DIR("A")="Press ENTER to continue..."

           DO ^DIR

           KILL DIR

 +8        QUIT 

SENDA31   ;Send one A31 message

 +1        NEW ERR,DIC,DT,DFN,BADERR,Y

 +2        SET DIC=2

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

           SET DIC(0)="AEQMZ"

           SET DT=$$DT^XLFDT

           DO ^DIC

           IF +Y>0

               Begin DoDot:1

 +3                SET DFN=+Y

 +4                DO A31(DFN)

 +5                IF '$DATA(ERR)

                       WRITE !,"Message was sent"

 +6               IF '$TEST

                       WRITE !,"Unable to send HL7 message"

               End DoDot:1

 +7       ;IHS/MSC/AMF 11/23/10 Remove H 2

           SET DIR(0)="EA"

           SET DIR("?")=""

           SET DIR("A")="Press ENTER to continue..."

           DO ^DIR

           KILL DIR

           WRITE !

 +8        QUIT 

A28(DFN)  ;EP Create and send one A28 message

 +1        NEW EVNTTYPE,DOD

 +2        SET EVNTTYPE="A28"

 +3       ;If patient has been merged, send the merged DFN

 +4        IF $DATA(^DPT(DFN,-9))

               QUIT 

 +5       ;IHS/MSC/AMF 11/23/10  descriptive alert

           IF '$DATA(^DPT(DFN,0))

               SET ERR="No zero node for patient.  Cannot send A28."

               DO NOTIF^BADEHL1(DFN,ERR)

               QUIT 

 +6       ;Patient must be alive

 +7        SET DOD=$PIECE($GET(^DPT(DFN,.35)),U,1)

 +8        IF DOD=""

               DO NEWMSG^BADEHL1(DFN,EVNTTYPE)

 +9        QUIT 

A31(DFN)  ;EP Create and send one A31 message

 +1        NEW EVNTTYPE,DOD

 +2        SET EVNTTYPE="A31"

 +3       ;IHS/MSC/AMF 11/23/10  descriptive alert

           IF '$DATA(^DPT(DFN,0))

               SET ERR="No zero node for patient.  Cannot send A31."

               DO NOTIF^BADEHL1(DFN,ERR)

               QUIT 

 +4       ;Don't send if patient is deceased

 +5       ;S DOD=$P($G(^DPT(DFN,.35)),U,1)

 +6       ;I DOD=""

 +7        DO NEWMSG^BADEHL1(DFN,EVNTTYPE)

 +8        QUIT 

MSA       ;EP

 +1        NEW MSA,HLST

 +2        DO SET(.ARY,"MSA",0)

 +3        DO SET(.ARY,"AA",1)

 +4        DO SET(.ARY,"TODO-MSGID",2)

 +5        DO SET(.ARY,"Transaction Successful",3)

 +6        DO SET(.ARY,"todo-010",4)

 +7        SET MSA=$$ADDSEG^HLOAPI(.HLST,.ARY)

 +8        QUIT 

SET(ARY,V,F,C,S,R) ;EP

 +1        DO SET^HLOAPI(.ARY,.V,.F,.C,.S,.R)

 +2        QUIT