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
