- APCLADXP ; IHS/CMI/LAB - print dx by age ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- START ;
- S APCL132="",$P(APCL132,"-",130)=""
- S Y=APCLBD D DD^%DT S APCLBDD=Y S Y=APCLED D DD^%DT S APCLEDD=Y
- S (APCLPG,APCLCODE)=0 D HEAD
- K APCLQUIT
- F S APCLCODE=$O(^XTMP("APCLADX",APCLJOB,APCLBT,"TALLY",APCLCODE)) Q:APCLCODE=""!($D(APCLQUIT)) D AGE
- G:$D(APCLQUIT) DONE
- I $Y>(IOSL-4) D HEAD G:$D(APCLQUIT) DONE
- W !,"TOTAL:" S J=39 F I=1:1:$L(APCLBIN,";") S K=$S($D(^XTMP("APCLADX",APCLJOB,APCLBT,"TOTAL","AGE",I)):^(I),1:".") W ?J,$J(K,6) S J=J+9
- W ?J,$J(APCLGRAN,6)
- DONE D DONE^APCLOSUT
- K ^XTMP("APCLADX",APCLJOB,APCLBT)
- Q
- AGE ;
- I $Y>(IOSL-4) D HEAD Q:$D(APCLQUIT)
- W !,APCLCODE S APCLNARR=$O(^XTMP("APCLADX",APCLJOB,APCLBT,"TALLY",APCLCODE,"")) W ?10,$E(APCLNARR,1,25)
- N I,J,K S J=39 F I=1:1:$L(APCLBIN,";") S K=$S($D(^XTMP("APCLADX",APCLJOB,APCLBT,"TALLY",APCLCODE,APCLNARR,I)):^(I),1:".") W ?J,$J(K,6) S J=J+9
- W ?J,$J(^XTMP("APCLADX",APCLJOB,APCLBT,"TOTAL","CODE",APCLCODE,APCLNARR),6)
- Q
- HEAD I 'APCLPG G HEAD1
- I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT="" Q
- HEAD1 ;
- W:$D(IOF) @IOF S APCLPG=APCLPG+1
- W !
- S X=$P(^DIC(4,DUZ(2),0),"^")
- W !,$P(^VA(200,DUZ,0),"^",2),?(132-$L(X)/2),X,?120,"Page ",APCLPG,!
- W ?54,"Diagnoses by Age Report",!
- W ?5,"Visit Dates: ",APCLBDD," to ",APCLEDD,?52,"Type of Visit: ",$S($D(APCLTYPP):APCLTYPP,1:"ALL"),?90,"Service Category: ",$S($D(APCLSCP):APCLSCP,1:"ALL"),!
- W ?5,"Location of Encounter: ",$S($D(APCLLOCP):$E(APCLLOCP,1,20),1:"ALL"),?52,"Clinic: ",$S($D(APCLCLNP):APCLCLNP,1:"ALL"),?90,"Sex of Patient: ",$S($D(APCLSEXP):APCLSEXP,1:"BOTH"),!
- W ?5,"Primary Provider: ",$S($D(APCLPRVP):APCLPRVP,1:"ALL"),?52,"Purpose of Visits: ",$S($D(APCLPRIM):"Primary Only",1:"Primary and Seconday POV's"),!!?61,"AGE GROUPS"
- N I,J,K W !,"ICD Code",?15,"ICD Narrative" S J=41 F I=1:1:$L(APCLBIN,";") S K=$P(APCLBIN,";",I) Q:K="" W ?J,K S J=J+9
- W ?J,"TOTAL"
- W !,APCL132
- Q
- APCLADXP ; IHS/CMI/LAB - print dx by age ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- START ;
- +1 SET APCL132=""
- SET $PIECE(APCL132,"-",130)=""
- +2 SET Y=APCLBD
- DO DD^%DT
- SET APCLBDD=Y
- SET Y=APCLED
- DO DD^%DT
- SET APCLEDD=Y
- +3 SET (APCLPG,APCLCODE)=0
- DO HEAD
- +4 KILL APCLQUIT
- +5 FOR
- SET APCLCODE=$ORDER(^XTMP("APCLADX",APCLJOB,APCLBT,"TALLY",APCLCODE))
- IF APCLCODE=""!($DATA(APCLQUIT))
- QUIT
- DO AGE
- +6 IF $DATA(APCLQUIT)
- GOTO DONE
- +7 IF $Y>(IOSL-4)
- DO HEAD
- IF $DATA(APCLQUIT)
- GOTO DONE
- +8 WRITE !,"TOTAL:"
- SET J=39
- FOR I=1:1:$LENGTH(APCLBIN,";")
- SET K=$SELECT($DATA(^XTMP("APCLADX",APCLJOB,APCLBT,"TOTAL","AGE",I)):^(I),1:".")
- WRITE ?J,$JUSTIFY(K,6)
- SET J=J+9
- +9 WRITE ?J,$JUSTIFY(APCLGRAN,6)
- DONE DO DONE^APCLOSUT
- +1 KILL ^XTMP("APCLADX",APCLJOB,APCLBT)
- +2 QUIT
- AGE ;
- +1 IF $Y>(IOSL-4)
- DO HEAD
- IF $DATA(APCLQUIT)
- QUIT
- +2 WRITE !,APCLCODE
- SET APCLNARR=$ORDER(^XTMP("APCLADX",APCLJOB,APCLBT,"TALLY",APCLCODE,""))
- WRITE ?10,$EXTRACT(APCLNARR,1,25)
- +3 NEW I,J,K
- SET J=39
- FOR I=1:1:$LENGTH(APCLBIN,";")
- SET K=$SELECT($DATA(^XTMP("APCLADX",APCLJOB,APCLBT,"TALLY",APCLCODE,APCLNARR,I)):^(I),1:".")
- WRITE ?J,$JUSTIFY(K,6)
- SET J=J+9
- +4 WRITE ?J,$JUSTIFY(^XTMP("APCLADX",APCLJOB,APCLBT,"TOTAL","CODE",APCLCODE,APCLNARR),6)
- +5 QUIT
- HEAD IF 'APCLPG
- GOTO HEAD1
- +1 IF $EXTRACT(IOST)="C"
- IF IO=IO(0)
- WRITE !
- SET DIR(0)="EO"
- DO ^DIR
- KILL DIR
- IF Y=0!(Y="^")!($DATA(DTOUT))
- SET APCLQUIT=""
- QUIT
- HEAD1 ;
- +1 IF $DATA(IOF)
- WRITE @IOF
- SET APCLPG=APCLPG+1
- +2 WRITE !
- +3 SET X=$PIECE(^DIC(4,DUZ(2),0),"^")
- +4 WRITE !,$PIECE(^VA(200,DUZ,0),"^",2),?(132-$LENGTH(X)/2),X,?120,"Page ",APCLPG,!
- +5 WRITE ?54,"Diagnoses by Age Report",!
- +6 WRITE ?5,"Visit Dates: ",APCLBDD," to ",APCLEDD,?52,"Type of Visit: ",$SELECT($DATA(APCLTYPP):APCLTYPP,1:"ALL"),?90,"Service Category: ",$SELECT($DATA(APCLSCP):APCLSCP,1:"ALL"),!
- +7 WRITE ?5,"Location of Encounter: ",$SELECT($DATA(APCLLOCP):$EXTRACT(APCLLOCP,1,20),1:"ALL"),?52,"Clinic: ",$SELECT($DATA(APCLCLNP):APCLCLNP,1:"ALL"),?90,"Sex of Patient: ",$SELECT($DATA(APCLSEXP):APCLSEXP,1:"BOTH"),!
- +8 WRITE ?5,"Primary Provider: ",$SELECT($DATA(APCLPRVP):APCLPRVP,1:"ALL"),?52,"Purpose of Visits: ",$SELECT($DATA(APCLPRIM):"Primary Only",1:"Primary and Seconday POV's"),!!?61,"AGE GROUPS"
- +9 NEW I,J,K
- WRITE !,"ICD Code",?15,"ICD Narrative"
- SET J=41
- FOR I=1:1:$LENGTH(APCLBIN,";")
- SET K=$PIECE(APCLBIN,";",I)
- IF K=""
- QUIT
- WRITE ?J,K
- SET J=J+9
- +10 WRITE ?J,"TOTAL"
- +11 WRITE !,APCL132
- +12 QUIT
