APCLNJ12 ; IHS/CMI/LAB - PRINT VISITS WITH INJURIES ;
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
;
;cmi/anch/maw 9/10/2007 code set versioning in PRNT
;
INIT ;initialize variables
S Y=APCLBD D DD^%DT S APCLBDD=Y S Y=APCLED D DD^%DT S APCLEDD=Y
D ^APCLNJ13 K APCLSTOP,APCLPAGE
S APCLSTOP="",APCLPAGE=0 D HEAD
I '$D(^XTMP("APCLNJ1",APCLJOB,APCLBT)) W !,"No injury visits to report." G END
;
SET ;
S APCLNAME=0
F S APCLNAME=$O(^XTMP("APCLNJ1",APCLJOB,APCLBT,APCLNAME)) Q:APCLNAME=""!(APCLSTOP="^") D SET2
END ;
D DONE^APCLOSUT
K ^XTMP("APCLNJ1",APCLJOB,APCLBT),APCLET
Q
SET2 ;
S APCLDFN=0
F S APCLDFN=$O(^XTMP("APCLNJ1",APCLJOB,APCLBT,APCLNAME,APCLDFN)) Q:APCLDFN'=+APCLDFN D
SET3 .S APCLVDT=0 F S APCLVDT=$O(^XTMP("APCLNJ1",APCLJOB,APCLBT,APCLNAME,APCLDFN,APCLVDT)) Q:APCLVDT=""!(APCLSTOP="^") D SET4
Q
SET4 ;
S APCLVDFN=$O(^XTMP("APCLNJ1",APCLJOB,APCLBT,APCLNAME,APCLDFN,APCLVDT,""))
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-8) D HEAD Q:APCLSTOP="^"
W !!,$E(APCLNAME,1,20),?22,$J(APCLHRCN,6),?32,$J(APCLAGE,2)
W ?38,$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 SET5
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 APCLCLS=$$PROVCLSC^XBFUNC1(X) G PRV1
S X=$P(^DIC(6,X,0),"^",4)
S APCLCLS=$S(X="":"",'$D(^DIC(7,X,9999999)):"",1:$P(^DIC(7,X,9999999),"^"))
PRV1 W ?54,APCLCLS
S APCLTYPE=$$EXTSET^XBFUNC(9000010,.03,$P(^AUPNVSIT(APCLVDFN,0),U,3)) W ?60,$E(APCLTYPE,1,9) S APCLSC=$$EXTSET^XBFUNC(9000010,.07,$P(^AUPNVSIT(APCLVDFN,0),U,7)) W ?70,$E(APCLSC,1,10)
;
;
SET5 ;
S APCLPOV=0 F S APCLPOV=$O(^XTMP("APCLNJ1",APCLJOB,APCLBT,APCLNAME,APCLDFN,APCLVDT,APCLVDFN,APCLPOV)) Q:APCLPOV=""!(APCLSTOP="^") D PRNT
Q
PRNT ;
I $Y>(IOSL-8) D HEAD Q:APCLSTOP="^"
;W !,"ICD9: ",$P(^ICD9(+^AUPNVPOV(APCLPOV,0),0),U),?19,"Provider Narrative: ",$S($P(^AUPNVPOV(APCLPOV,0),U,4):$E($P(^AUTNPOV($P(^AUPNVPOV(APCLPOV,0),U,4),0),U),1,40),1:"????") ;cmi/anch/maw 9/10/2007 orig line
W !,"ICD: ",$P($$ICDDX^ICDEX(+^AUPNVPOV(APCLPOV,0)),U,2),?19,"Provider Narrative: ",$S($P(^AUPNVPOV(APCLPOV,0),U,4):$E($$VAL^XBDIQ1(9000010.07,APCLPOV,.04),1,40),1:"????") ;cmi/anch/maw 9/10/2007 csv
;I $P(^AUPNVPOV(APCLPOV,0),U,9)]"" W !,"Cause of Injury: ",?19,$P(^ICD9($P(^AUPNVPOV(APCLPOV,0),U,9),0),U)," - ",$P(^(0),U,3) ;cmi/anch/maw 9/10/2007 orig line
I $P(^AUPNVPOV(APCLPOV,0),U,9)]"" W !,"Cause of Injury: ",?19,$P($$ICDDX^ICDEX($P(^AUPNVPOV(APCLPOV,0),U,9)),U,2)," - ",$E($P($$ICDDX^ICDEX($P(^AUPNVPOV(APCLPOV,0),U,9)),U,4),1,45) ;cmi/anch/maw 9/10/2007 csv PATCH 21
I $P(^AUPNVPOV(APCLPOV,0),U,18)]"" W !,"Cause of Injury #2: ",?19,$P($$ICDDX^ICDEX($P(^AUPNVPOV(APCLPOV,0),U,18)),U,2)," - ",$E($P($$ICDDX^ICDEX($P(^AUPNVPOV(APCLPOV,0),U,18)),U,4),1,45)
I $P(^AUPNVPOV(APCLPOV,0),U,19)]"" W !,"Cause of Injury #3: ",?19,$P($$ICDDX^ICDEX($P(^AUPNVPOV(APCLPOV,0),U,19)),U,2)," - ",$E($P($$ICDDX^ICDEX($P(^AUPNVPOV(APCLPOV,0),U,19)),U,4),1,45)
;W !,"F/R: " I $P(^AUPNVPOV(APCLPOV,0),U,8)]"" S APCLFR=$$EXTSET^XBFUNC(9000010.07,.08,$P(^AUPNVPOV(APCLPOV,0),U,8)) W APCLFR
I $P(^AUPNVPOV(APCLPOV,0),U,13)]"" W !,"Date of Injury: ",?19,$E($P(^AUPNVPOV(APCLPOV,0),U,13),4,5),"/",$E($P(^AUPNVPOV(APCLPOV,0),U,13),6,7),"/",$E($P(^AUPNVPOV(APCLPOV,0),U,13),2,3)
I $P(^AUPNVPOV(APCLPOV,0),U,11)]"" S APCLPA=$$EXTSET^XBFUNC(9000010.07,.11,$P(^AUPNVPOV(APCLPOV,0),U,11)) W !,"Place of Accident: ",APCLPA
I $P(^AUPNVPOV(APCLPOV,0),U,21)]"" W !,"Place of Occurence: ",?19,$P($$ICDDX^ICDEX($P(^AUPNVPOV(APCLPOV,0),U,21)),U,2)," - ",$E($P($$ICDDX^ICDEX($P(^AUPNVPOV(APCLPOV,0),U,21)),U,4),1,45)
I $P(^AUPNVPOV(APCLPOV,0),U,23)]"" W !,"Retained Foreign Body: ",?19,$P($$ICDDX^ICDEX($P(^AUPNVPOV(APCLPOV,0),U,23)),U,2)," - ",$E($P($$ICDDX^ICDEX($P(^AUPNVPOV(APCLPOV,0),U,23)),U,4),1,45)
I $P(^AUPNVPOV(APCLPOV,0),U,7)]"" W !,"Cause of DX: ",$$EXTSET^XBFUNC(9000010.07,.07,$P(^AUPNVPOV(APCLPOV,0),U,7))
Q
HEAD I 'APCLPAGE 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 APCLSTOP="^" Q
HEAD1 ;
W:$D(IOF) @IOF S APCLPAGE=APCLPAGE+1
W !
S X=$P(^DIC(4,DUZ(2),0),"^")
W !,$P(^VA(200,DUZ,0),"^",2),?(80-$L(X)/2),X,?72,"Page ",APCLPAGE,!
W ?26,"Visits with Injury Diagnosis",!
W ?15,"Visit Dates: ",APCLBDD," to ",APCLEDD
W !!,"PATIENT",?23,"HRCN",?31,"AGE",?40,"VISIT DATE",?54,"PRV",?60,"TYPE",?70,"SER CAT",!
W "--------------------------------------------------------------------------------"
Q
TIME NEW Y,%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
APCLNJ12 ; IHS/CMI/LAB - PRINT VISITS WITH INJURIES ;
+1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
+2 ;
+3 ;cmi/anch/maw 9/10/2007 code set versioning in PRNT
+4 ;
INIT ;initialize variables
+1 SET Y=APCLBD
DO DD^%DT
SET APCLBDD=Y
SET Y=APCLED
DO DD^%DT
SET APCLEDD=Y
+2 DO ^APCLNJ13
KILL APCLSTOP,APCLPAGE
+3 SET APCLSTOP=""
SET APCLPAGE=0
DO HEAD
+4 IF '$DATA(^XTMP("APCLNJ1",APCLJOB,APCLBT))
WRITE !,"No injury visits to report."
GOTO END
+5 ;
SET ;
+1 SET APCLNAME=0
+2 FOR
SET APCLNAME=$ORDER(^XTMP("APCLNJ1",APCLJOB,APCLBT,APCLNAME))
IF APCLNAME=""!(APCLSTOP="^")
QUIT
DO SET2
END ;
+1 DO DONE^APCLOSUT
+2 KILL ^XTMP("APCLNJ1",APCLJOB,APCLBT),APCLET
+3 QUIT
SET2 ;
+1 SET APCLDFN=0
+2 FOR
SET APCLDFN=$ORDER(^XTMP("APCLNJ1",APCLJOB,APCLBT,APCLNAME,APCLDFN))
IF APCLDFN'=+APCLDFN
QUIT
Begin DoDot:1
SET3 SET APCLVDT=0
FOR
SET APCLVDT=$ORDER(^XTMP("APCLNJ1",APCLJOB,APCLBT,APCLNAME,APCLDFN,APCLVDT))
IF APCLVDT=""!(APCLSTOP="^")
QUIT
DO SET4
End DoDot:1
+1 QUIT
SET4 ;
+1 SET APCLVDFN=$ORDER(^XTMP("APCLNJ1",APCLJOB,APCLBT,APCLNAME,APCLDFN,APCLVDT,""))
+2 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-8)
DO HEAD
IF APCLSTOP="^"
QUIT
+4 WRITE !!,$EXTRACT(APCLNAME,1,20),?22,$JUSTIFY(APCLHRCN,6),?32,$JUSTIFY(APCLAGE,2)
+5 WRITE ?38,$EXTRACT(APCLVDT,4,5),"/",$EXTRACT(APCLVDT,6,7),"/",$EXTRACT(APCLVDT,2,3)_" "_$EXTRACT($PIECE(APCLVDT,".",2)_"0000",1,4)
+6 ;
+7 SET APCLPRV=0
PRV SET APCLPRV=$ORDER(^AUPNVPRV("AD",APCLVDFN,APCLPRV))
+1 IF APCLPRV=""
SET APCLPV=0
GOTO SET5
+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 APCLCLS=$$PROVCLSC^XBFUNC1(X)
GOTO PRV1
+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),"^"))
PRV1 WRITE ?54,APCLCLS
+1 SET APCLTYPE=$$EXTSET^XBFUNC(9000010,.03,$PIECE(^AUPNVSIT(APCLVDFN,0),U,3))
WRITE ?60,$EXTRACT(APCLTYPE,1,9)
SET APCLSC=$$EXTSET^XBFUNC(9000010,.07,$PIECE(^AUPNVSIT(APCLVDFN,0),U,7))
WRITE ?70,$EXTRACT(APCLSC,1,10)
+2 ;
+3 ;
SET5 ;
+1 SET APCLPOV=0
FOR
SET APCLPOV=$ORDER(^XTMP("APCLNJ1",APCLJOB,APCLBT,APCLNAME,APCLDFN,APCLVDT,APCLVDFN,APCLPOV))
IF APCLPOV=""!(APCLSTOP="^")
QUIT
DO PRNT
+2 QUIT
PRNT ;
+1 IF $Y>(IOSL-8)
DO HEAD
IF APCLSTOP="^"
QUIT
+2 ;W !,"ICD9: ",$P(^ICD9(+^AUPNVPOV(APCLPOV,0),0),U),?19,"Provider Narrative: ",$S($P(^AUPNVPOV(APCLPOV,0),U,4):$E($P(^AUTNPOV($P(^AUPNVPOV(APCLPOV,0),U,4),0),U),1,40),1:"????") ;cmi/anch/maw 9/10/2007 orig line
+3 ;cmi/anch/maw 9/10/2007 csv
WRITE !,"ICD: ",$PIECE($$ICDDX^ICDEX(+^AUPNVPOV(APCLPOV,0)),U,2),?19,"Provider Narrative: ",$SELECT($PIECE(^AUPNVPOV(APCLPOV,0),U,4):$EXTRACT($$VAL^XBDIQ1(9000010.07,APCLPOV,.04),1,40),1:"????")
+4 ;I $P(^AUPNVPOV(APCLPOV,0),U,9)]"" W !,"Cause of Injury: ",?19,$P(^ICD9($P(^AUPNVPOV(APCLPOV,0),U,9),0),U)," - ",$P(^(0),U,3) ;cmi/anch/maw 9/10/2007 orig line
+5 ;cmi/anch/maw 9/10/2007 csv PATCH 21
IF $PIECE(^AUPNVPOV(APCLPOV,0),U,9)]""
WRITE !,"Cause of Injury: ",?19,$PIECE($$ICDDX^ICDEX($PIECE(^AUPNVPOV(APCLPOV,0),U,9)),U,2)," - ",$EXTRACT($PIECE($$ICDDX^ICDEX($PIECE(^AUPNVPOV(APCLPOV,0),U,9)),U,4),1,45)
+6 IF $PIECE(^AUPNVPOV(APCLPOV,0),U,18)]""
WRITE !,"Cause of Injury #2: ",?19,$PIECE($$ICDDX^ICDEX($PIECE(^AUPNVPOV(APCLPOV,0),U,18)),U,2)," - ",$EXTRACT($PIECE($$ICDDX^ICDEX($PIECE(^AUPNVPOV(APCLPOV,0),U,18)),U,4),1,45)
+7 IF $PIECE(^AUPNVPOV(APCLPOV,0),U,19)]""
WRITE !,"Cause of Injury #3: ",?19,$PIECE($$ICDDX^ICDEX($PIECE(^AUPNVPOV(APCLPOV,0),U,19)),U,2)," - ",$EXTRACT($PIECE($$ICDDX^ICDEX($PIECE(^AUPNVPOV(APCLPOV,0),U,19)),U,4),1,45)
+8 ;W !,"F/R: " I $P(^AUPNVPOV(APCLPOV,0),U,8)]"" S APCLFR=$$EXTSET^XBFUNC(9000010.07,.08,$P(^AUPNVPOV(APCLPOV,0),U,8)) W APCLFR
+9 IF $PIECE(^AUPNVPOV(APCLPOV,0),U,13)]""
WRITE !,"Date of Injury: ",?19,$EXTRACT($PIECE(^AUPNVPOV(APCLPOV,0),U,13),4,5),"/",$EXTRACT($PIECE(^AUPNVPOV(APCLPOV,0),U,13),6,7),"/",$EXTRACT($PIECE(^AUPNVPOV(APCLPOV,0),U,13),2,3)
+10 IF $PIECE(^AUPNVPOV(APCLPOV,0),U,11)]""
SET APCLPA=$$EXTSET^XBFUNC(9000010.07,.11,$PIECE(^AUPNVPOV(APCLPOV,0),U,11))
WRITE !,"Place of Accident: ",APCLPA
+11 IF $PIECE(^AUPNVPOV(APCLPOV,0),U,21)]""
WRITE !,"Place of Occurence: ",?19,$PIECE($$ICDDX^ICDEX($PIECE(^AUPNVPOV(APCLPOV,0),U,21)),U,2)," - ",$EXTRACT($PIECE($$ICDDX^ICDEX($PIECE(^AUPNVPOV(APCLPOV,0),U,21)),U,4),1,45)
+12 IF $PIECE(^AUPNVPOV(APCLPOV,0),U,23)]""
WRITE !,"Retained Foreign Body: ",?19,$PIECE($$ICDDX^ICDEX($PIECE(^AUPNVPOV(APCLPOV,0),U,23)),U,2)," - ",$EXTRACT($PIECE($$ICDDX^ICDEX($PIECE(^AUPNVPOV(APCLPOV,0),U,23)),U,4),1,45)
+13 IF $PIECE(^AUPNVPOV(APCLPOV,0),U,7)]""
WRITE !,"Cause of DX: ",$$EXTSET^XBFUNC(9000010.07,.07,$PIECE(^AUPNVPOV(APCLPOV,0),U,7))
+14 QUIT
HEAD IF 'APCLPAGE
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 APCLSTOP="^"
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET APCLPAGE=APCLPAGE+1
+2 WRITE !
+3 SET X=$PIECE(^DIC(4,DUZ(2),0),"^")
+4 WRITE !,$PIECE(^VA(200,DUZ,0),"^",2),?(80-$LENGTH(X)/2),X,?72,"Page ",APCLPAGE,!
+5 WRITE ?26,"Visits with Injury Diagnosis",!
+6 WRITE ?15,"Visit Dates: ",APCLBDD," to ",APCLEDD
+7 WRITE !!,"PATIENT",?23,"HRCN",?31,"AGE",?40,"VISIT DATE",?54,"PRV",?60,"TYPE",?70,"SER CAT",!
+8 WRITE "--------------------------------------------------------------------------------"
+9 QUIT
TIME NEW Y,%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
