APCM13SL.m

APCM13SL ; IHS/CMI/LAB - IHS MU ;

 ;;1.0;IHS MU PERFORMANCE REPORTS;**2**;MAR 26, 2012;Build 11

 ;; ;

RT ;EP

 ;for each measure list, choose report type

 W !!,"Select List Type.",!,"NOTE:  If you select All Patients, your list may be",!,"hundreds of pages and take hours to print.",!

 S DIR(0)="S^R:Random Patient List;A:All Patients",DIR("A")="Choose report type for the Lists",DIR("B")="R" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) S APCMQUIT="" K APCMLIST Q

 S APCMLIST=Y

 Q

EP ;EP - CALLED FROM OPTION

 D EN

 Q

EOJ1 ;EP

 K APCMGLST,APCMTIND,APCMHIGH,APCMANS,APCMC,APCMGANS,APCMGC,APCMGI,APCMI,APCMX

 Q

 ;; ;

EN ;EP -- main entry point for GPRA LIST DISPLAY

 D EN^VALM("APCM 13 S1 LIST SELECTION")

 D CLEAR^VALM1

 D FULL^VALM1

 W:$D(IOF) @IOF

 D EOJ1

 Q

 ;

HDR ; -- header code

 S VALMHDR(1)="IHS 2013 MU Stage 1 Measure Lists of Patients"

 S VALMHDR(2)="* indicates the list has been selected"

 Q

 ;

INIT ; -- init variables and list array

 K APCMGLST,APCMNOLI S APCMHIGH=""

 S APCMXREF=$S(APCMRPTT=1:"EOORDER",1:"AH")

 S (Y,C,I)=0 F  S Y=$O(^APCM13OB(APCMXREF,Y)) Q:Y'=+Y  Q:Y=""  S X=0 F  S X=$O(^APCM13OB(APCMXREF,Y,X)) Q:X'=+X  D

 .Q:'$D(APCMIND(X))

 .I $P(^APCM13OB(X,0),U,7)="" S C=C+1 D  Q

 ..S APCMGLST(C,0)=C_")",$E(APCMGLST(C,0),5)="("_$P(^APCM13OB(X,0),U,3)_") "_$P(^APCM13OB(X,0),U,5),APCMGLST("IDX",C,C)=X I $D(APCMLIST(X)) S APCMGLST(C,0)="*"_APCMGLST(C,0)

 .I $P(^APCM13OB(X,0),U,7)=1 Q  ;S C=C+1 D

 .;.S APCMGLST(C,0)="NO patient list available for measure:  "_$P(^APCM13OB(X,0),U,5),APCMGLST("IDX",C,C)=X,APCMNOLI(X)="" I $D(APCMLIST(X)) S APCMGLST(C,0)="*"_APCMGLST(C,0)

 S (VALMCNT,APCMHIGH)=C

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 Q

 ;

EXPND ; -- expand code

 Q

 ;

BACK ;go back to listman

 D TERM^VALM0

 S VALMBCK="R"

 D INIT

 D HDR

 K DIR

 K X,Y,Z,I

 Q

 ;

ADD ;EP - add an item to the selected list - called from a protocol

 W ! S DIR(0)="LO^1:"_APCMHIGH,DIR("A")="Which item(s)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !,"No items selected." G ADDX

 I $D(DIRUT) W !,"No items selected." G ADDX

 D FULL^VALM1 W:$D(IOF) @IOF

 S APCMGANS=Y,APCMGC="" F APCMGI=1:1 S APCMGC=$P(APCMGANS,",",APCMGI) Q:APCMGC=""  S APCMI=APCMGLST("IDX",APCMGC,APCMGC) I $D(APCMIND(APCMI)),'$D(APCMNOLI(APCMI)) S APCMLIST(APCMI)=""

ADDX ;

 D BACK

 Q

ADDALL ;

 F X=1:1:APCMHIGH S I=$G(APCMGLST("IDX",X,X)) I $D(APCMIND(I)),'$D(APCMNOLI(I)) S APCMLIST(I)=""

 D BACK

 Q

 ;

REM ;

 W ! S DIR(0)="LO^1:"_APCMHIGH,DIR("A")="Which item(s)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I Y="" W !,"No items selected." G ADDX

 I $D(DIRUT) W !,"No items selected." G ADDX

 D FULL^VALM1 W:$D(IOF) @IOF

 S APCMGANS=Y,APCMGC="" F APCMGI=1:1 S APCMGC=$P(APCMGANS,",",APCMGI) Q:APCMGC=""  S I=APCMGLST("IDX",APCMGC,APCMGC) K APCMLIST(I)

REMX ;

 D BACK

 Q

 ;

PT ;EP

 S (APCMROT,APCMDELT,APCMDELF)=""

 W !!,"Please choose an output type.  For an explanation of the delimited",!,"file please see the user manual.",!

 S DIR(0)="S^P:Print Report on Printer or Screen;D:Create Delimited output file (for use in Excel);B:Both a Printed Report and Delimited File",DIR("A")="Select an Output Option",DIR("B")="P" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) Q

 S APCMROT=Y

 Q:APCMROT="P"

 S APCMDELF="",APCMDELT=""

 W !!,"You have selected to create a delimited output file.  You can have this",!,"output file created as a text file in the pub directory, ",!,"OR you can have the delimited output display on your screen so that"

 W !,"you can do a file capture.  Keep in mind that if you choose to",!,"do a screen capture you CANNOT Queue your report to run in the background!!",!!

 S DIR(0)="S^S:SCREEN - delimited output will display on screen for capture;F:FILE - delimited output will be written to a file in pub",DIR("A")="Select output type",DIR("B")="S" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G PT

 S APCMDELT=Y

 Q:APCMDELT="S"

 S DIR(0)="F^1:40",DIR("A")="Enter a filename for the delimited output (no more than 40 characters)" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G PT

 S APCMDELF=Y

 W !!,"When the report is finished your delimited output will be found in the",!,$P($G(^AUTTSITE(1,1)),U,2)," directory.  The filename will be ",APCMDELF,".txt",!

 Q

REPORT ;EP

 S APCMRPT=""

 W !!

 ;CREATE REPORT ENTRY IN FILEMAN FILE

 ;3 files must have the same ien

 L +^APCMM13C:30 I '$T W !!,"Unable to lock global, try later." G REPORTX

 L +^APCMM13P:30 I '$T W !!,"Unable to lock global, try later." G REPORTX

 D GETIEN

 I 'APCMIEN W !!,"Something wrong with control files, notify programmer!" S APCMRPT="" G REPORTX

 S DINUM=APCMIEN

 K DIC S X=APCMBD,DIC(0)="L",DIC="^APCMM13C(",DLAYGO=9001301.03,DIADD=1,DIC("DR")=".02////"_APCMED_";.03////"_APCMPBD_";.04////"_APCMPED_";.05////"_DUZ(2)_";.06////"_$S(APCMRPT=1:"E",1:"H")_";.07////"_$$NOW^XLFDT()

 D ^DIC K DIC,DA,DR,DIADD,DLAYGO I Y=-1 W !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!" S APCMQUIT=1 G REPORTX

 S APCMRPT=+Y

 ;set 11 multiple with variable pointers to each provider/hospital

 I APCMRPTT=1 D  S ^APCMM13C(APCMRPT,11,0)="^9001301.0311AV^"_C_"^"_C

 .S X=0,C=0 F  S X=$O(APCMPRV(X)) Q:X'=+X  S C=C+1 D

 ..S ^APCMM13C(APCMRPT,11,C,0)=X_";VA(200,"

 ..S ^APCMM13C(APCMRPT,11,"B",X_";VA(200,",C)=""

 I APCMRPTT=2 D  S ^APCMM13C(APCMRPT,11,0)="^9001301.0311AV^"_C_"^"_C

 .S X=0,C=1,X=APCMFAC D

 ..S ^APCMM13C(APCMRPT,11,C,0)=X_";AUTTLOC("

 ..S ^APCMM13C(APCMRPT,11,"B",X_";AUTTLOC(",C)=""

 K DIC S X=APCMBD,DIC(0)="L",DIC="^APCMM13P(",DLAYGO=9001301.04,DIADD=1,DIC("DR")=".02////"_APCMED_";.03////"_APCMPBD_";.04////"_APCMPED_";.05////"_DUZ(2)_";.06////"_$S(APCMRPT=1:"E",1:"H")_";.07////"_$$NOW^XLFDT()

 S DINUM=APCMRPT D ^DIC K DIC,DA,DR,DIADD,DLAYGO,DINUM I Y=-1 W !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!" S APCMQUIT=1 G REPORTX

 S APCMRPTP=+Y

 I APCMRPTT=1 D  S ^APCMM13P(APCMRPTP,11,0)="^9001301.0411AV^"_C_"^"_C

 .S X=0,C=0 F  S X=$O(APCMPRV(X)) Q:X'=+X  S C=C+1 D

 ..S ^APCMM13P(APCMRPTP,11,C,0)=X_";VA(200,"

 ..S ^APCMM13P(APCMRPTP,11,"B",X_";VA(200,",C)=""

 I APCMRPTT=2 D  S ^APCMM13P(APCMRPT,11,0)="^9001301.0411AV^"_C_"^"_C

 .S X=0,C=0,X=APCMFAC,C=C+1 D

 ..S ^APCMM13P(APCMRPT,11,C,0)=X_";AUTTLOC("

 ..S ^APCMM13P(APCMRPT,11,"B",X_";AUTTLOC(",C)=""

REPORTX ;

 D ^XBFMK

 K DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM

 L -^APCMM13C

 L -^APCMM13P

 Q

GETIEN ;EP -Get next ien available in all 3 files

 S APCMF=9001301.03 D ENT

 S APCMF=9001301.04 D ENT

 S APCMIEN=$P(^APCMM13C(0),U,3)+1

S I $D(^APCMM13P(APCMIEN)) S APCMIEN=APCMIEN+1 G S

 Q

 ;

ENT ;

 NEW GBL,NXT,CTR,XBHI,XBX,XBY,ANS

 S GBL=^DIC(APCMF,0,"GL")

 S GBL=GBL_"NXT)"

 S (XBHI,NXT,CTR)=0

 F L=0:0 S NXT=$O(@(GBL)) Q:NXT'=+NXT  S XBHI=NXT,CTR=CTR+1 ;W:'(CTR#50) "."

 S NXT="",XBX=$O(@(GBL)),XBX=^(0),XBY=$P(XBX,U,4),XBX=$P(XBX,U,3)

 S NXT=0,$P(@(GBL),U,3)=XBHI,$P(^(0),U,4)=CTR

 ;

EOJ ;

 KILL ANS,XBHI,XBX,XBY,CTR,DIC,FILE,GBL,L,NXT,APCMF

 Q

APCM13SL  ; IHS/CMI/LAB - IHS MU ;

 +1       ;;1.0;IHS MU PERFORMANCE REPORTS;**2**;MAR 26, 2012;Build 11

 +2       ;; ;

RT        ;EP

 +1       ;for each measure list, choose report type

 +2        WRITE !!,"Select List Type.",!,"NOTE:  If you select All Patients, your list may be",!,"hundreds of pages and take hours to print.",!

 +3        SET DIR(0)="S^R:Random Patient List;A:All Patients"

           SET DIR("A")="Choose report type for the Lists"

           SET DIR("B")="R"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               SET APCMQUIT=""

               KILL APCMLIST

               QUIT 

 +5        SET APCMLIST=Y

 +6        QUIT 

EP        ;EP - CALLED FROM OPTION

 +1        DO EN

 +2        QUIT 

EOJ1      ;EP

 +1        KILL APCMGLST,APCMTIND,APCMHIGH,APCMANS,APCMC,APCMGANS,APCMGC,APCMGI,APCMI,APCMX

 +2        QUIT 

 +3       ;; ;

EN        ;EP -- main entry point for GPRA LIST DISPLAY

 +1        DO EN^VALM("APCM 13 S1 LIST SELECTION")

 +2        DO CLEAR^VALM1

 +3        DO FULL^VALM1

 +4        IF $DATA(IOF)

               WRITE @IOF

 +5        DO EOJ1

 +6        QUIT 

 +7       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)="IHS 2013 MU Stage 1 Measure Lists of Patients"

 +2        SET VALMHDR(2)="* indicates the list has been selected"

 +3        QUIT 

 +4       ;

INIT      ; -- init variables and list array

 +1        KILL APCMGLST,APCMNOLI

           SET APCMHIGH=""

 +2        SET APCMXREF=$SELECT(APCMRPTT=1:"EOORDER",1:"AH")

 +3        SET (Y,C,I)=0

           FOR 

               SET Y=$ORDER(^APCM13OB(APCMXREF,Y))

               IF Y'=+Y

                   QUIT 

               IF Y=""

                   QUIT 

               SET X=0

               FOR 

                   SET X=$ORDER(^APCM13OB(APCMXREF,Y,X))

                   IF X'=+X

                       QUIT 

                   Begin DoDot:1

 +4                    IF '$DATA(APCMIND(X))

                           QUIT 

 +5                    IF $PIECE(^APCM13OB(X,0),U,7)=""

                           SET C=C+1

                           Begin DoDot:2

 +6                            SET APCMGLST(C,0)=C_")"

                               SET $EXTRACT(APCMGLST(C,0),5)="("_$PIECE(^APCM13OB(X,0),U,3)_") "_$PIECE(^APCM13OB(X,0),U,5)

                               SET APCMGLST("IDX",C,C)=X

                               IF $DATA(APCMLIST(X))

                                   SET APCMGLST(C,0)="*"_APCMGLST(C,0)

                           End DoDot:2

                           QUIT 

 +7       ;S C=C+1 D

                       IF $PIECE(^APCM13OB(X,0),U,7)=1

                           QUIT 

 +8       ;.S APCMGLST(C,0)="NO patient list available for measure:  "_$P(^APCM13OB(X,0),U,5),APCMGLST("IDX",C,C)=X,APCMNOLI(X)="" I $D(APCMLIST(X)) S APCMGLST(C,0)="*"_APCMGLST(C,0)

                   End DoDot:1

 +9        SET (VALMCNT,APCMHIGH)=C

 +10       QUIT 

 +11      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        QUIT 

 +2       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

BACK      ;go back to listman

 +1        DO TERM^VALM0

 +2        SET VALMBCK="R"

 +3        DO INIT

 +4        DO HDR

 +5        KILL DIR

 +6        KILL X,Y,Z,I

 +7        QUIT 

 +8       ;

ADD       ;EP - add an item to the selected list - called from a protocol

 +1        WRITE !

           SET DIR(0)="LO^1:"_APCMHIGH

           SET DIR("A")="Which item(s)"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF Y=""

               WRITE !,"No items selected."

               GOTO ADDX

 +3        IF $DATA(DIRUT)

               WRITE !,"No items selected."

               GOTO ADDX

 +4        DO FULL^VALM1

           IF $DATA(IOF)

               WRITE @IOF

 +5        SET APCMGANS=Y

           SET APCMGC=""

           FOR APCMGI=1:1

               SET APCMGC=$PIECE(APCMGANS,",",APCMGI)

               IF APCMGC=""

                   QUIT 

               SET APCMI=APCMGLST("IDX",APCMGC,APCMGC)

               IF $DATA(APCMIND(APCMI))

                   IF '$DATA(APCMNOLI(APCMI))

                       SET APCMLIST(APCMI)=""

ADDX      ;

 +1        DO BACK

 +2        QUIT 

ADDALL    ;

 +1        FOR X=1:1:APCMHIGH

               SET I=$GET(APCMGLST("IDX",X,X))

               IF $DATA(APCMIND(I))

                   IF '$DATA(APCMNOLI(I))

                       SET APCMLIST(I)=""

 +2        DO BACK

 +3        QUIT 

 +4       ;

REM       ;

 +1        WRITE !

           SET DIR(0)="LO^1:"_APCMHIGH

           SET DIR("A")="Which item(s)"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF Y=""

               WRITE !,"No items selected."

               GOTO ADDX

 +3        IF $DATA(DIRUT)

               WRITE !,"No items selected."

               GOTO ADDX

 +4        DO FULL^VALM1

           IF $DATA(IOF)

               WRITE @IOF

 +5        SET APCMGANS=Y

           SET APCMGC=""

           FOR APCMGI=1:1

               SET APCMGC=$PIECE(APCMGANS,",",APCMGI)

               IF APCMGC=""

                   QUIT 

               SET I=APCMGLST("IDX",APCMGC,APCMGC)

               KILL APCMLIST(I)

REMX      ;

 +1        DO BACK

 +2        QUIT 

 +3       ;

PT        ;EP

 +1        SET (APCMROT,APCMDELT,APCMDELF)=""

 +2        WRITE !!,"Please choose an output type.  For an explanation of the delimited",!,"file please see the user manual.",!

 +3        SET DIR(0)="S^P:Print Report on Printer or Screen;D:Create Delimited output file (for use in Excel);B:Both a Printed Report and Delimited File"

           SET DIR("A")="Select an Output Option"

           SET DIR("B")="P"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               QUIT 

 +5        SET APCMROT=Y

 +6        IF APCMROT="P"

               QUIT 

 +7        SET APCMDELF=""

           SET APCMDELT=""

 +8        WRITE !!,"You have selected to create a delimited output file.  You can have this",!,"output file created as a text file in the pub directory, ",!,"OR you can have the delimited output display on your screen so that"

 +9        WRITE !,"you can do a file capture.  Keep in mind that if you choose to",!,"do a screen capture you CANNOT Queue your report to run in the background!!",!!

 +10       SET DIR(0)="S^S:SCREEN - delimited output will display on screen for capture;F:FILE - delimited output will be written to a file in pub"

           SET DIR("A")="Select output type"

           SET DIR("B")="S"

           KILL DA

           DO ^DIR

           KILL DIR

 +11       IF $DATA(DIRUT)

               GOTO PT

 +12       SET APCMDELT=Y

 +13       IF APCMDELT="S"

               QUIT 

 +14       SET DIR(0)="F^1:40"

           SET DIR("A")="Enter a filename for the delimited output (no more than 40 characters)"

           KILL DA

           DO ^DIR

           KILL DIR

 +15       IF $DATA(DIRUT)

               GOTO PT

 +16       SET APCMDELF=Y

 +17       WRITE !!,"When the report is finished your delimited output will be found in the",!,$PIECE($GET(^AUTTSITE(1,1)),U,2)," directory.  The filename will be ",APCMDELF,".txt",!

 +18       QUIT 

REPORT    ;EP

 +1        SET APCMRPT=""

 +2        WRITE !!

 +3       ;CREATE REPORT ENTRY IN FILEMAN FILE

 +4       ;3 files must have the same ien

 +5        LOCK +^APCMM13C:30

           IF '$TEST

               WRITE !!,"Unable to lock global, try later."

               GOTO REPORTX

 +6        LOCK +^APCMM13P:30

           IF '$TEST

               WRITE !!,"Unable to lock global, try later."

               GOTO REPORTX

 +7        DO GETIEN

 +8        IF 'APCMIEN

               WRITE !!,"Something wrong with control files, notify programmer!"

               SET APCMRPT=""

               GOTO REPORTX

 +9        SET DINUM=APCMIEN

 +10       KILL DIC

           SET X=APCMBD

           SET DIC(0)="L"

           SET DIC="^APCMM13C("

           SET DLAYGO=9001301.03

           SET DIADD=1

           SET DIC("DR")=".02////"_APCMED_";.03////"_APCMPBD_";.04////"_APCMPED_";.05////"_DUZ(2)_";.06////"_$SELECT(APCMRPT=1:"E",1:"H")_";.07////"_$$NOW^XLFDT()

 +11       DO ^DIC

           KILL DIC,DA,DR,DIADD,DLAYGO

           IF Y=-1

               WRITE !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!"

               SET APCMQUIT=1

               GOTO REPORTX

 +12       SET APCMRPT=+Y

 +13      ;set 11 multiple with variable pointers to each provider/hospital

 +14       IF APCMRPTT=1

               Begin DoDot:1

 +15               SET X=0

                   SET C=0

                   FOR 

                       SET X=$ORDER(APCMPRV(X))

                       IF X'=+X

                           QUIT 

                       SET C=C+1

                       Begin DoDot:2

 +16                       SET ^APCMM13C(APCMRPT,11,C,0)=X_";VA(200,"

 +17                       SET ^APCMM13C(APCMRPT,11,"B",X_";VA(200,",C)=""

                       End DoDot:2

               End DoDot:1

               SET ^APCMM13C(APCMRPT,11,0)="^9001301.0311AV^"_C_"^"_C

 +18       IF APCMRPTT=2

               Begin DoDot:1

 +19               SET X=0

                   SET C=1

                   SET X=APCMFAC

                   Begin DoDot:2

 +20                   SET ^APCMM13C(APCMRPT,11,C,0)=X_";AUTTLOC("

 +21                   SET ^APCMM13C(APCMRPT,11,"B",X_";AUTTLOC(",C)=""

                   End DoDot:2

               End DoDot:1

               SET ^APCMM13C(APCMRPT,11,0)="^9001301.0311AV^"_C_"^"_C

 +22       KILL DIC

           SET X=APCMBD

           SET DIC(0)="L"

           SET DIC="^APCMM13P("

           SET DLAYGO=9001301.04

           SET DIADD=1

           SET DIC("DR")=".02////"_APCMED_";.03////"_APCMPBD_";.04////"_APCMPED_";.05////"_DUZ(2)_";.06////"_$SELECT(APCMRPT=1:"E",1:"H")_";.07////"_$$NOW^XLFDT()

 +23       SET DINUM=APCMRPT

           DO ^DIC

           KILL DIC,DA,DR,DIADD,DLAYGO,DINUM

           IF Y=-1

               WRITE !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!"

               SET APCMQUIT=1

               GOTO REPORTX

 +24       SET APCMRPTP=+Y

 +25       IF APCMRPTT=1

               Begin DoDot:1

 +26               SET X=0

                   SET C=0

                   FOR 

                       SET X=$ORDER(APCMPRV(X))

                       IF X'=+X

                           QUIT 

                       SET C=C+1

                       Begin DoDot:2

 +27                       SET ^APCMM13P(APCMRPTP,11,C,0)=X_";VA(200,"

 +28                       SET ^APCMM13P(APCMRPTP,11,"B",X_";VA(200,",C)=""

                       End DoDot:2

               End DoDot:1

               SET ^APCMM13P(APCMRPTP,11,0)="^9001301.0411AV^"_C_"^"_C

 +29       IF APCMRPTT=2

               Begin DoDot:1

 +30               SET X=0

                   SET C=0

                   SET X=APCMFAC

                   SET C=C+1

                   Begin DoDot:2

 +31                   SET ^APCMM13P(APCMRPT,11,C,0)=X_";AUTTLOC("

 +32                   SET ^APCMM13P(APCMRPT,11,"B",X_";AUTTLOC(",C)=""

                   End DoDot:2

               End DoDot:1

               SET ^APCMM13P(APCMRPT,11,0)="^9001301.0411AV^"_C_"^"_C

REPORTX   ;

 +1        DO ^XBFMK

 +2        KILL DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM

 +3        LOCK -^APCMM13C

 +4        LOCK -^APCMM13P

 +5        QUIT 

GETIEN    ;EP -Get next ien available in all 3 files

 +1        SET APCMF=9001301.03

           DO ENT

 +2        SET APCMF=9001301.04

           DO ENT

 +3        SET APCMIEN=$PIECE(^APCMM13C(0),U,3)+1

S          IF $DATA(^APCMM13P(APCMIEN))

               SET APCMIEN=APCMIEN+1

               GOTO S

 +1        QUIT 

 +2       ;

ENT       ;

 +1        NEW GBL,NXT,CTR,XBHI,XBX,XBY,ANS

 +2        SET GBL=^DIC(APCMF,0,"GL")

 +3        SET GBL=GBL_"NXT)"

 +4        SET (XBHI,NXT,CTR)=0

 +5       ;W:'(CTR#50) "."

           FOR L=0:0

               SET NXT=$ORDER(@(GBL))

               IF NXT'=+NXT

                   QUIT 

               SET XBHI=NXT

               SET CTR=CTR+1

 +6        SET NXT=""

           SET XBX=$ORDER(@(GBL))

           SET XBX=^(0)

           SET XBY=$PIECE(XBX,U,4)

           SET XBX=$PIECE(XBX,U,3)

 +7        SET NXT=0

           SET $PIECE(@(GBL),U,3)=XBHI

           SET $PIECE(^(0),U,4)=CTR

 +8       ;

EOJ       ;

 +1        KILL ANS,XBHI,XBX,XBY,CTR,DIC,FILE,GBL,L,NXT,APCMF

 +2        QUIT