- 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 ;----------
