CIMGAGPX ; IHS/OHPRD/TMJ - PRINT VISITS WITH INJURIES ; [ 01/27/00 9:49 AM ]
;;1.0;ABERDEEN GPRA REPORT;;JAN 22, 2000
;
INIT ;initialize variables
S CIMGPG=0
D HEADER Q:CIMQUIT
I '$D(^XTMP("CIMGAGP",CIMGJ,CIMGH)) W !,"No injury visits to report." G END
;
SET ;
S CIMNAME=0
F S CIMNAME=$O(^XTMP("CIMGAGP",CIMGJ,CIMGH,"INJURIES",CIMNAME)) Q:CIMNAME=""!(CIMQUIT) D SET2
END ;
Q
SET2 ;
S DFN=0
F S DFN=$O(^XTMP("CIMGAGP",CIMGJ,CIMGH,"INJURIES",CIMNAME,DFN)) Q:DFN'=+DFN D SET3
Q
SET3 ;
S CIMV=0 F S CIMV=$O(^XTMP("CIMGAGP",CIMGJ,CIMGH,"INJURIES",CIMNAME,DFN,CIMV)) Q:CIMV=""!(CIMQUIT) D SET4
Q
SET4 ;
I $Y>(IOSL-8) D HEADER Q:CIMQUIT
W !!,$E(CIMNAME,1,20),?22,$J($$HRN^AUPNPAT(DFN,DUZ(2)),6),?32,$J($$AGE^AUPNPAT(DFN,$P($P(^AUPNVSIT(CIMV,0),U),".")),2),?40,$P($G(^AUPNPAT(DFN,11)),U,18)
S D=$P(^AUPNVSIT(CIMV,0),U) W ?60,$E(D,4,5),"/",$E(D,6,7),"/",(1700+$E(D,1,3))
;
;
;
SET5 ;
S CIMPOV=0 F S CIMPOV=$O(^XTMP("CIMGAGP",CIMGJ,CIMGH,"INJURIES",CIMNAME,DFN,CIMV,CIMPOV)) Q:CIMPOV=""!(CIMQUIT) D PRNT
Q
PRNT ;
I $Y>(IOSL-8) D HEADER Q:CIMQUIT
W !,"ICD9: ",$P(^ICD9(+^AUPNVPOV(CIMPOV,0),0),U),?19,"Provider Narrative: ",$S($P(^AUPNVPOV(CIMPOV,0),U,4):$E($P(^AUTNPOV($P(^AUPNVPOV(CIMPOV,0),U,4),0),U),1,40),1:"<no narrative available>")
I $P(^AUPNVPOV(CIMPOV,0),U,9)]"" W !,"Cause of Injury: ",?19,$P(^ICD9($P(^AUPNVPOV(CIMPOV,0),U,9),0),U)," - ",$P(^(0),U,3)
I $P(^AUPNVPOV(CIMPOV,0),U,13)]"" W !,"Date of Injury: ",?19,$E($P(^AUPNVPOV(CIMPOV,0),U,13),4,5),"/",$E($P(^AUPNVPOV(CIMPOV,0),U,13),6,7),"/",$E($P(^AUPNVPOV(CIMPOV,0),U,13),2,3)
Q
I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S CIMQUIT=1 Q
W:$D(IOF) @IOF S CIMGPG=CIMGPG+1
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",CIMGPG,!
W !,$$CTR("*** ABERDEEN AREA GPRA INDICATORS ***",80),!
W $$CTR($P(^DIC(4,DUZ(2),0),U)),!
S X="Reporting Period: "_$$FMTE^XLFDT(CIMBD)_" to "_$$FMTE^XLFDT(CIMED) W $$CTR(X,80),!
S X="Baseline Period: "_$$FMTE^XLFDT(CIM98B)_" to "_$$FMTE^XLFDT(CIM98E) W $$CTR(X,80),!
W ?26,"Visits with Injury Diagnosis",!
W !!,"PATIENT",?23,"HRCN",?31,"AGE",?40,"COMMUNITY",?60,"VISIT DATE",!
W "--------------------------------------------------------------------------------"
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
CIMGAGPX ; IHS/OHPRD/TMJ - PRINT VISITS WITH INJURIES ; [ 01/27/00 9:49 AM ]
+1 ;;1.0;ABERDEEN GPRA REPORT;;JAN 22, 2000
+2 ;
INIT ;initialize variables
+1 SET CIMGPG=0
+2 DO HEADER
IF CIMQUIT
QUIT
+3 IF '$DATA(^XTMP("CIMGAGP",CIMGJ,CIMGH))
WRITE !,"No injury visits to report."
GOTO END
+4 ;
SET ;
+1 SET CIMNAME=0
+2 FOR
SET CIMNAME=$ORDER(^XTMP("CIMGAGP",CIMGJ,CIMGH,"INJURIES",CIMNAME))
IF CIMNAME=""!(CIMQUIT)
QUIT
DO SET2
END ;
+1 QUIT
SET2 ;
+1 SET DFN=0
+2 FOR
SET DFN=$ORDER(^XTMP("CIMGAGP",CIMGJ,CIMGH,"INJURIES",CIMNAME,DFN))
IF DFN'=+DFN
QUIT
DO SET3
+3 QUIT
SET3 ;
+1 SET CIMV=0
FOR
SET CIMV=$ORDER(^XTMP("CIMGAGP",CIMGJ,CIMGH,"INJURIES",CIMNAME,DFN,CIMV))
IF CIMV=""!(CIMQUIT)
QUIT
DO SET4
+2 QUIT
SET4 ;
+1 IF $Y>(IOSL-8)
DO HEADER
IF CIMQUIT
QUIT
+2 WRITE !!,$EXTRACT(CIMNAME,1,20),?22,$JUSTIFY($$HRN^AUPNPAT(DFN,DUZ(2)),6),?32,$JUSTIFY($$AGE^AUPNPAT(DFN,$PIECE($PIECE(^AUPNVSIT(CIMV,0),U),".")),2),?40,$PIECE($GET(^AUPNPAT(DFN,11)),U,18)
+3 SET D=$PIECE(^AUPNVSIT(CIMV,0),U)
WRITE ?60,$EXTRACT(D,4,5),"/",$EXTRACT(D,6,7),"/",(1700+$EXTRACT(D,1,3))
+4 ;
+5 ;
+6 ;
SET5 ;
+1 SET CIMPOV=0
FOR
SET CIMPOV=$ORDER(^XTMP("CIMGAGP",CIMGJ,CIMGH,"INJURIES",CIMNAME,DFN,CIMV,CIMPOV))
IF CIMPOV=""!(CIMQUIT)
QUIT
DO PRNT
+2 QUIT
PRNT ;
+1 IF $Y>(IOSL-8)
DO HEADER
IF CIMQUIT
QUIT
+2 WRITE !,"ICD9: ",$PIECE(^ICD9(+^AUPNVPOV(CIMPOV,0),0),U),?19,"Provider Narrative: ",$SELECT($PIECE(^AUPNVPOV(CIMPOV,0),U,4):$EXTRACT($PIECE(^AUTNPOV($PIECE(^AUPNVPOV(CIMPOV,0),U,4),0),U),1,40),1:"<no narrative available>")
+3 IF $PIECE(^AUPNVPOV(CIMPOV,0),U,9)]""
WRITE !,"Cause of Injury: ",?19,$PIECE(^ICD9($PIECE(^AUPNVPOV(CIMPOV,0),U,9),0),U)," - ",$PIECE(^(0),U,3)
+4 IF $PIECE(^AUPNVPOV(CIMPOV,0),U,13)]""
WRITE !,"Date of Injury: ",?19,$EXTRACT($PIECE(^AUPNVPOV(CIMPOV,0),U,13),4,5),"/",$EXTRACT($PIECE(^AUPNVPOV(CIMPOV,0),U,13),6,7),"/",$EXTRACT($PIECE(^AUPNVPOV(CIMPOV,0),U,13),2,3)
+5 QUIT
GOTO HEADER1
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
IF '$DATA(ZTQUEUED)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET CIMQUIT=1
QUIT
+1 IF $DATA(IOF)
WRITE @IOF
SET CIMGPG=CIMGPG+1
+2 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",CIMGPG,!
+3 WRITE !,$$CTR("*** ABERDEEN AREA GPRA INDICATORS ***",80),!
+4 WRITE $$CTR($PIECE(^DIC(4,DUZ(2),0),U)),!
+5 SET X="Reporting Period: "_$$FMTE^XLFDT(CIMBD)_" to "_$$FMTE^XLFDT(CIMED)
WRITE $$CTR(X,80),!
+6 SET X="Baseline Period: "_$$FMTE^XLFDT(CIM98B)_" to "_$$FMTE^XLFDT(CIM98E)
WRITE $$CTR(X,80),!
+7 WRITE ?26,"Visits with Injury Diagnosis",!
+8 WRITE !!,"PATIENT",?23,"HRCN",?31,"AGE",?40,"COMMUNITY",?60,"VISIT DATE",!
+9 WRITE "--------------------------------------------------------------------------------"
+10 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
