APCLYV32 ; IHS/CMI/LAB - PRINT CLINIC VISITS ;
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
;
;cmi/anch/maw 9/12/2007 code set versioning POV,PRC
;
INIT ;
S APCLSTOP="",APCLPAGE=0
I '$D(^XTMP("APCLYV3",APCLJOB,APCLBT)) D HEAD W !,"No visits to report." G END
S (APCLPGRD,APCLVGRA)=0
;
SET ;
S APCLCLX=0
F S APCLCLX=$O(^XTMP("APCLYV3",APCLJOB,APCLBT,APCLCLX)) Q:APCLCLX=""!(APCLSTOP="^") D SET2
G:APCLSTOP="^" END
D FINAL
END ;
D DONE^APCLOSUT
K ^XTMP("APCLYV3",APCLJOB,APCLBT)
Q
SET2 ;
S (APCLNAME,APCLPTOT,APCLVTOT)=0 D HEAD
F S APCLNAME=$O(^XTMP("APCLYV3",APCLJOB,APCLBT,APCLCLX,APCLNAME)) Q:APCLNAME=""!(APCLSTOP="^") S APCLDFN=0 D SET3
Q:APCLSTOP="^"
D TOTALS
Q
SET3 F S APCLDFN=$O(^XTMP("APCLYV3",APCLJOB,APCLBT,APCLCLX,APCLNAME,APCLDFN)) Q:APCLDFN=""!(APCLSTOP="^") D SET4
Q
SET4 ;
S (APCLVDT,APCLFVS)=0 ;visit date & first visit flag for line feed
S APCLPTOT=APCLPTOT+1 ;increment patient count for clinic
I $G(APCLLOC)]"",$D(^AUPNPAT(APCLDFN,41,APCLLOC,0)) S APCLHRCN=$P(^AUPNPAT(APCLDFN,41,APCLLOC,0),U,2) G SET41
S APCLHRCN=$S($D(^AUPNPAT(APCLDFN,41,DUZ(2),0)):$P(^(0),U,2),1:"")
SET41 ;
K ^UTILITY("DIQ1",$J) S DIC=9000001,DA=APCLDFN,DR=1102.99 D EN^DIQ1
S APCLAGE=$G(^UTILITY("DIQ1",$J,9000001,APCLDFN,1102.99)) K ^UTILITY("DIQ1",$J)
I $Y>(IOSL-5) D PAGE Q:APCLSTOP="^"
W !,$E(APCLNAME,1,13),?15,$J(APCLHRCN,6),?23,$J(APCLAGE,2)
;
F S APCLVDT=$O(^XTMP("APCLYV3",APCLJOB,APCLBT,APCLCLX,APCLNAME,APCLDFN,APCLVDT)) Q:APCLVDT="" S APCLVDFN=0 D SET5
Q
SET5 ;
F S APCLVDFN=$O(^XTMP("APCLYV3",APCLJOB,APCLBT,APCLCLX,APCLNAME,APCLDFN,APCLVDT,APCLVDFN)) Q:APCLVDFN=""!(APCLSTOP="^") D PRNT
Q
PRNT ;
S APCLVTOT=APCLVTOT+1
I APCLFVS W ! I $Y>(IOSL-5) D PAGE Q:APCLSTOP="^"
S APCLFPV=0,APCLFVS=1
W ?26,$E(APCLVDT,4,5),"/",$E(APCLVDT,6,7),"/",$E(APCLVDT,2,3)_" "_$E($P(APCLVDT,".",2)_"0000",1,4)
;
S APCLPRV=0
PRV S APCLPRV=$O(^AUPNVPRV("AD",APCLVDFN,APCLPRV))
I APCLPRV="" S APCLPV=0 G POV
G PRV:'$D(^AUPNVPRV(APCLPRV,0)),PRV:$P(^(0),"^",4)'="P"
S X=+^AUPNVPRV(APCLPRV,0)
I $P(^DD(9000010.06,.01,0),U,2)[200 S APCLCLSC=$$PROVCLSC^XBFUNC1(X) W ?41,$E(APCLCLSC,1,3) G PRVJMP
S X=$P(^DIC(6,X,0),"^",4)
S APCLCLS=$S(X="":"",'$D(^DIC(7,X,9999999)):"??",1:$P(^DIC(7,X,9999999),"^"))
W ?41,APCLCLS
;
;
PRVJMP ;
S APCLPV=0
POV S APCLPV=$O(^AUPNVPOV("AD",APCLVDFN,APCLPV))
I APCLPV="" S APCLVPRC=0 G PRC
G POV:'$D(^AUPNVPOV(APCLPV,0)) S APCLSTR=^(0)
S APCLVRV=$P(APCLSTR,"^",8),APCLPS=$P(APCLSTR,"^",12)
S APCLVPOV=+APCLSTR,APCLNAR=$P(APCLSTR,"^",4)
;S APCLVPOV=$S(APCLVPOV="":"",1:$P(^ICD9(APCLVPOV,0),"^")) ;cmi/anch/maw 9/12/2007 orig line
S APCLVPOV=$S(APCLVPOV="":"",1:$P($$ICDDX^ICDEX(APCLVPOV),"^",2)) ;cmi/anch/maw 9/12/2007 csv
S APCLNAR=$$VAL^XBDIQ1(9000010.07,APCLPV,.04) ;$S(APCLNAR="":"",$D(^AUTNPOV(APCLNAR,0)):$P(^(0),"^"),1:"")
I APCLFPV W ! I $Y>(IOSL-5) D PAGE Q:APCLSTOP="^" W !
I 'APCLFPV S APCLFPV=1
W ?45,APCLVPOV,?56,$E(APCLNAR,1,23)
G POV
;
;set and print procedures
PRC S APCLVPRC=$O(^AUPNVPRC("AD",APCLVDFN,APCLVPRC))
Q:APCLVPRC=""
G PRC:'$D(^AUPNVPRC(APCLVPRC,0)) S APCLSTR=^(0)
S APCLVRV=$P(APCLSTR,"^",8),APCLPS=$P(APCLSTR,"^",12)
S APCLPRC=+APCLSTR,APCLNAR=$P(APCLSTR,"^",4)
;S APCLPRC=$S(APCLPRC="":"",1:$P(^ICD0(APCLPRC,0),"^")) ;cmi/anch/maw 9/12/2007 orig line
S APCLPRC=$S(APCLPRC="":"",1:$P($$ICDOP^ICDEX(APCLPRC,,,"I"),"^",2)) ;cmi/anch/maw 9/12/2007 csv
S APCLNAR=$S(APCLNAR="":"",$D(^AUTNPOV(APCLNAR,0)):$P(^(0),"^"),1:"")
I APCLFPV W ! I $Y>(IOSL-5) D PAGE Q:APCLSTOP="^" W !
I 'APCLFPV S APCLFPV=1
W ?45,APCLPRC,?56,$E(APCLNAR,1,23)
G PRC
;
FINAL ;
Q:APCLCL'="A"
D HEAD
W !!?39,"TOTAL PATIENTS: ",APCLPGRD
W !!?41,"TOTAL VISITS: ",APCLVGRA
Q
;
TOTALS ;print totals
I $Y>(IOSL-5) D PAGE
W !!?28,"TOTAL PATIENTS FOR CLINIC: ",APCLPTOT
W !!?30,"TOTAL VISITS FOR CLINIC: ",APCLVTOT
S APCLPGRD=APCLPGRD+APCLPTOT,APCLVGRA=APCLVGRA+APCLVTOT
Q:IOST'?1"C-".E
;R !!,"Enter <return> to continue or '^' to stop",APCLSTOP:DTIME
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I $D(DIRUT) S APCLSTOP="^" Q
Q
;
HEAD ;
W:$D(IOF) @IOF,!?11,"*****Confidential Patient Data Covered by Privacy Act*****",!
S X=$P(^DIC(4,DUZ(2),0),"^"),APCLPAGE=APCLPAGE+1
W !!,$P(^VA(200,DUZ,0),"^",2),?(80-$L(X)/2),X,?70,"Page ",APCLPAGE
S X=$P($H,",",2) D TIME W !,Y
I $G(APCLCLX)="" S X="No Clinic data to report" G HD1
I APCLCLX="E" S X="VISITS WITH NO ASSIGNED CLINIC CODE" G HD1
I APCLCLX]"" S X="CLINIC VISITS FOR "_$P(^DIC(40.7,APCLCLX,0),"^")_" ("_$P(^(0),"^",2)_")" W ?(80-$L(X)/2),X
HD1 S Y=DT X ^DD("DD") W !,Y
W ?28,"for ",$E(APCLBD,4,5),"/",$E(APCLBD,6,7),"/",$E(APCLBD,2,3)
W " to ",$E(APCLED,4,5),"/",$E(APCLED,6,7),"/",$E(APCLED,2,3)
W !!,"NAME",?16,"HRCN",?22,"AGE",?27,"VISIT DATE",?41,"PRV",?46,"ICD",?56,"PROV NARRATIVE",!
Q
;
PAGE ;form feed to new page
I IOST'?1"C-".E D HEAD Q
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="E" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLSTOP="^" Q
I APCLSTOP'="^" D HEAD
Q
TIME NEW %A,%B,%C S Y="" Q:'$D(X) Q:X<0!(X>86400)
S %A=X\60,%B=%A\60 S:%B>12 %B=%B-12 S:%B=0 %B=12 S:%B<10 %B=" "_%B
S %C=$S(%A=0:"M ",%A=720:"N ",%A=1440:"M ",%A<720:"am",1:"pm")
S Y=%B_":"_$E(%A#60+100,2,3)_" "_%C K %A,%B,%C Q
APCLYV32 ; IHS/CMI/LAB - PRINT CLINIC VISITS ;
+1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
+2 ;
+3 ;cmi/anch/maw 9/12/2007 code set versioning POV,PRC
+4 ;
INIT ;
+1 SET APCLSTOP=""
SET APCLPAGE=0
+2 IF '$DATA(^XTMP("APCLYV3",APCLJOB,APCLBT))
DO HEAD
WRITE !,"No visits to report."
GOTO END
+3 SET (APCLPGRD,APCLVGRA)=0
+4 ;
SET ;
+1 SET APCLCLX=0
+2 FOR
SET APCLCLX=$ORDER(^XTMP("APCLYV3",APCLJOB,APCLBT,APCLCLX))
IF APCLCLX=""!(APCLSTOP="^")
QUIT
DO SET2
+3 IF APCLSTOP="^"
GOTO END
+4 DO FINAL
END ;
+1 DO DONE^APCLOSUT
+2 KILL ^XTMP("APCLYV3",APCLJOB,APCLBT)
+3 QUIT
SET2 ;
+1 SET (APCLNAME,APCLPTOT,APCLVTOT)=0
DO HEAD
+2 FOR
SET APCLNAME=$ORDER(^XTMP("APCLYV3",APCLJOB,APCLBT,APCLCLX,APCLNAME))
IF APCLNAME=""!(APCLSTOP="^")
QUIT
SET APCLDFN=0
DO SET3
+3 IF APCLSTOP="^"
QUIT
+4 DO TOTALS
+5 QUIT
SET3 FOR
SET APCLDFN=$ORDER(^XTMP("APCLYV3",APCLJOB,APCLBT,APCLCLX,APCLNAME,APCLDFN))
IF APCLDFN=""!(APCLSTOP="^")
QUIT
DO SET4
+1 QUIT
SET4 ;
+1 ;visit date & first visit flag for line feed
SET (APCLVDT,APCLFVS)=0
+2 ;increment patient count for clinic
SET APCLPTOT=APCLPTOT+1
+3 IF $GET(APCLLOC)]""
IF $DATA(^AUPNPAT(APCLDFN,41,APCLLOC,0))
SET APCLHRCN=$PIECE(^AUPNPAT(APCLDFN,41,APCLLOC,0),U,2)
GOTO SET41
+4 SET APCLHRCN=$SELECT($DATA(^AUPNPAT(APCLDFN,41,DUZ(2),0)):$PIECE(^(0),U,2),1:"")
SET41 ;
+1 KILL ^UTILITY("DIQ1",$JOB)
SET DIC=9000001
SET DA=APCLDFN
SET DR=1102.99
DO EN^DIQ1
+2 SET APCLAGE=$GET(^UTILITY("DIQ1",$JOB,9000001,APCLDFN,1102.99))
KILL ^UTILITY("DIQ1",$JOB)
+3 IF $Y>(IOSL-5)
DO PAGE
IF APCLSTOP="^"
QUIT
+4 WRITE !,$EXTRACT(APCLNAME,1,13),?15,$JUSTIFY(APCLHRCN,6),?23,$JUSTIFY(APCLAGE,2)
+5 ;
+6 FOR
SET APCLVDT=$ORDER(^XTMP("APCLYV3",APCLJOB,APCLBT,APCLCLX,APCLNAME,APCLDFN,APCLVDT))
IF APCLVDT=""
QUIT
SET APCLVDFN=0
DO SET5
+7 QUIT
SET5 ;
+1 FOR
SET APCLVDFN=$ORDER(^XTMP("APCLYV3",APCLJOB,APCLBT,APCLCLX,APCLNAME,APCLDFN,APCLVDT,APCLVDFN))
IF APCLVDFN=""!(APCLSTOP="^")
QUIT
DO PRNT
+2 QUIT
PRNT ;
+1 SET APCLVTOT=APCLVTOT+1
+2 IF APCLFVS
WRITE !
IF $Y>(IOSL-5)
DO PAGE
IF APCLSTOP="^"
QUIT
+3 SET APCLFPV=0
SET APCLFVS=1
+4 WRITE ?26,$EXTRACT(APCLVDT,4,5),"/",$EXTRACT(APCLVDT,6,7),"/",$EXTRACT(APCLVDT,2,3)_" "_$EXTRACT($PIECE(APCLVDT,".",2)_"0000",1,4)
+5 ;
+6 SET APCLPRV=0
PRV SET APCLPRV=$ORDER(^AUPNVPRV("AD",APCLVDFN,APCLPRV))
+1 IF APCLPRV=""
SET APCLPV=0
GOTO POV
+2 IF '$DATA(^AUPNVPRV(APCLPRV,0))
GOTO PRV
IF $PIECE(^(0),"^",4)'="P"
GOTO PRV
+3 SET X=+^AUPNVPRV(APCLPRV,0)
+4 IF $PIECE(^DD(9000010.06,.01,0),U,2)[200
SET APCLCLSC=$$PROVCLSC^XBFUNC1(X)
WRITE ?41,$EXTRACT(APCLCLSC,1,3)
GOTO PRVJMP
+5 SET X=$PIECE(^DIC(6,X,0),"^",4)
+6 SET APCLCLS=$SELECT(X="":"",'$DATA(^DIC(7,X,9999999)):"??",1:$PIECE(^DIC(7,X,9999999),"^"))
+7 WRITE ?41,APCLCLS
+8 ;
+9 ;
PRVJMP ;
+1 SET APCLPV=0
POV SET APCLPV=$ORDER(^AUPNVPOV("AD",APCLVDFN,APCLPV))
+1 IF APCLPV=""
SET APCLVPRC=0
GOTO PRC
+2 IF '$DATA(^AUPNVPOV(APCLPV,0))
GOTO POV
SET APCLSTR=^(0)
+3 SET APCLVRV=$PIECE(APCLSTR,"^",8)
SET APCLPS=$PIECE(APCLSTR,"^",12)
+4 SET APCLVPOV=+APCLSTR
SET APCLNAR=$PIECE(APCLSTR,"^",4)
+5 ;S APCLVPOV=$S(APCLVPOV="":"",1:$P(^ICD9(APCLVPOV,0),"^")) ;cmi/anch/maw 9/12/2007 orig line
+6 ;cmi/anch/maw 9/12/2007 csv
SET APCLVPOV=$SELECT(APCLVPOV="":"",1:$PIECE($$ICDDX^ICDEX(APCLVPOV),"^",2))
+7 ;$S(APCLNAR="":"",$D(^AUTNPOV(APCLNAR,0)):$P(^(0),"^"),1:"")
SET APCLNAR=$$VAL^XBDIQ1(9000010.07,APCLPV,.04)
+8 IF APCLFPV
WRITE !
IF $Y>(IOSL-5)
DO PAGE
IF APCLSTOP="^"
QUIT
WRITE !
+9 IF 'APCLFPV
SET APCLFPV=1
+10 WRITE ?45,APCLVPOV,?56,$EXTRACT(APCLNAR,1,23)
+11 GOTO POV
+12 ;
+13 ;set and print procedures
PRC SET APCLVPRC=$ORDER(^AUPNVPRC("AD",APCLVDFN,APCLVPRC))
+1 IF APCLVPRC=""
QUIT
+2 IF '$DATA(^AUPNVPRC(APCLVPRC,0))
GOTO PRC
SET APCLSTR=^(0)
+3 SET APCLVRV=$PIECE(APCLSTR,"^",8)
SET APCLPS=$PIECE(APCLSTR,"^",12)
+4 SET APCLPRC=+APCLSTR
SET APCLNAR=$PIECE(APCLSTR,"^",4)
+5 ;S APCLPRC=$S(APCLPRC="":"",1:$P(^ICD0(APCLPRC,0),"^")) ;cmi/anch/maw 9/12/2007 orig line
+6 ;cmi/anch/maw 9/12/2007 csv
SET APCLPRC=$SELECT(APCLPRC="":"",1:$PIECE($$ICDOP^ICDEX(APCLPRC,,,"I"),"^",2))
+7 SET APCLNAR=$SELECT(APCLNAR="":"",$DATA(^AUTNPOV(APCLNAR,0)):$PIECE(^(0),"^"),1:"")
+8 IF APCLFPV
WRITE !
IF $Y>(IOSL-5)
DO PAGE
IF APCLSTOP="^"
QUIT
WRITE !
+9 IF 'APCLFPV
SET APCLFPV=1
+10 WRITE ?45,APCLPRC,?56,$EXTRACT(APCLNAR,1,23)
+11 GOTO PRC
+12 ;
FINAL ;
+1 IF APCLCL'="A"
QUIT
+2 DO HEAD
+3 WRITE !!?39,"TOTAL PATIENTS: ",APCLPGRD
+4 WRITE !!?41,"TOTAL VISITS: ",APCLVGRA
+5 QUIT
+6 ;
TOTALS ;print totals
+1 IF $Y>(IOSL-5)
DO PAGE
+2 WRITE !!?28,"TOTAL PATIENTS FOR CLINIC: ",APCLPTOT
+3 WRITE !!?30,"TOTAL VISITS FOR CLINIC: ",APCLVTOT
+4 SET APCLPGRD=APCLPGRD+APCLPTOT
SET APCLVGRA=APCLVGRA+APCLVTOT
+5 IF IOST'?1"C-".E
QUIT
+6 ;R !!,"Enter <return> to continue or '^' to stop",APCLSTOP:DTIME
+7 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET APCLSTOP="^"
QUIT
+8 QUIT
+9 ;
HEAD ;
+1 IF $DATA(IOF)
WRITE @IOF,!?11,"*****Confidential Patient Data Covered by Privacy Act*****",!
+2 SET X=$PIECE(^DIC(4,DUZ(2),0),"^")
SET APCLPAGE=APCLPAGE+1
+3 WRITE !!,$PIECE(^VA(200,DUZ,0),"^",2),?(80-$LENGTH(X)/2),X,?70,"Page ",APCLPAGE
+4 SET X=$PIECE($HOROLOG,",",2)
DO TIME
WRITE !,Y
+5 IF $GET(APCLCLX)=""
SET X="No Clinic data to report"
GOTO HD1
+6 IF APCLCLX="E"
SET X="VISITS WITH NO ASSIGNED CLINIC CODE"
GOTO HD1
+7 IF APCLCLX]""
SET X="CLINIC VISITS FOR "_$PIECE(^DIC(40.7,APCLCLX,0),"^")_" ("_$PIECE(^(0),"^",2)_")"
WRITE ?(80-$LENGTH(X)/2),X
HD1 SET Y=DT
XECUTE ^DD("DD")
WRITE !,Y
+1 WRITE ?28,"for ",$EXTRACT(APCLBD,4,5),"/",$EXTRACT(APCLBD,6,7),"/",$EXTRACT(APCLBD,2,3)
+2 WRITE " to ",$EXTRACT(APCLED,4,5),"/",$EXTRACT(APCLED,6,7),"/",$EXTRACT(APCLED,2,3)
+3 WRITE !!,"NAME",?16,"HRCN",?22,"AGE",?27,"VISIT DATE",?41,"PRV",?46,"ICD",?56,"PROV NARRATIVE",!
+4 QUIT
+5 ;
PAGE ;form feed to new page
+1 IF IOST'?1"C-".E
DO HEAD
QUIT
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLSTOP="^"
QUIT
+3 IF APCLSTOP'="^"
DO HEAD
+4 QUIT
TIME NEW %A,%B,%C
SET Y=""
IF '$DATA(X)
QUIT
IF X<0!(X>86400)
QUIT
+1 SET %A=X\60
SET %B=%A\60
IF %B>12
SET %B=%B-12
IF %B=0
SET %B=12
IF %B<10
SET %B=" "_%B
+2 SET %C=$SELECT(%A=0:"M ",%A=720:"N ",%A=1440:"M ",%A<720:"am",1:"pm")
+3 SET Y=%B_":"_$EXTRACT(%A#60+100,2,3)_" "_%C
KILL %A,%B,%C
QUIT
