APCLER2P ; IHS/CMI/LAB - PRINT CLINIC VISITS ;
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
;
;
INIT ;
S APCLDT=$$FMTE^XLFDT(DT)
S Y=APCLBD D DD^%DT S APCLBDD=Y S Y=APCLED D DD^%DT S APCLEDD=Y
S APCLPG=0
I '$D(^XTMP("APCLER2",APCLJOB,APCLBTH)) D HEAD W !,"No visits to report." G END
;
SET ;
D HEAD
S APCLVDFN=0
F S APCLVDFN=$O(^XTMP("APCLER2",APCLJOB,APCLBTH,APCLVDFN)) Q:APCLVDFN=""!($D(APCLQUIT)) D SET2
END ;
D DONE^APCLOSUT
K ^XTMP("APCLER2",APCLJOB,APCLBTH)
Q
SET2 ;
S APCLVER=^XTMP("APCLER2",APCLJOB,APCLBTH,APCLVDFN)
S APCLVREC=^AUPNVSIT(APCLVDFN,0)
S APCLHRCN=$S($D(^AUPNPAT($P(APCLVREC,U,5),41,DUZ(2),0)):$J($P(^AUTTLOC(DUZ(2),0),U,7),4)_" "_$P(^AUPNPAT($P(APCLVREC,U,5),41,DUZ(2),0),U,2),1:"<NONE>")
PRN ;
S APCLNAME=$E($P(^DPT($P(APCLVREC,U,5),0),U),1,15)
K ^UTILITY("DIQ1",$J) S DIC=9000001,DA=$P(APCLVREC,U,5),DR=1102.99 D EN^DIQ1
S APCLAGE=$G(^UTILITY("DIQ1",$J,9000001,$P(APCLVREC,U,5),1102.99)) K ^UTILITY("DIQ1",$J)
S APCLVD=$E($P(APCLVREC,U),4,5)_"/"_$E($P(APCLVREC,U),6,7)_"/"_$E($P(APCLVREC,U),2,3) S Y=$P(APCLVREC,U) D DD^%DT S APCLVD=APCLVD_" "_$P(Y,"@",2)
S APCLFAC=$P(^AUTTLOC($P(APCLVREC,U,6),0),U,7)
PRINT1 ;
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
W !,APCLNAME,?16,APCLHRCN,?28,APCLVD,?45,?49,APCLFAC S APCLFRST=0,APCLP=0
F S APCLP=$O(^AUPNVPOV("AD",APCLVDFN,APCLP)) Q:APCLP'=+APCLP D
.W:APCLFRST !
.S APCLFRST=APCLFRST+1
.W ?54,$P($$ICDDX^ICDEX($P(^AUPNVPOV(APCLP,0),U)),U,2) W:$P(^AUPNVPOV(APCLP,0),U,4)]"" ?64,$E($$VAL^XBDIQ1(9000010.07,APCLP,.04),1,16)
PRINT2 ;
S APCLVD=$E($P(^AUPNVSIT(APCLVER,0),U),4,5)_"/"_$E($P(^AUPNVSIT(APCLVER,0),U),6,7)_"/"_$E($P(^AUPNVSIT(APCLVER,0),U),2,3) S Y=$P(^AUPNVSIT(APCLVER,0),U) D DD^%DT S APCLVD=APCLVD_" "_$P(Y,"@",2)
S APCLCLN=$S($P(^AUPNVSIT(APCLVER,0),U,8):$P(^DIC(40.7,$P(^AUPNVSIT(APCLVER,0),U,8),0),U,2),1:"--")
S APCLFAC=$S($P(^AUPNVSIT(APCLVER,0),U,6):$P(^AUTTLOC($P(^AUPNVSIT(APCLVER,0),U,6),0),U,7),1:"--")
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
W !?3,"ER Visit Information =>",?28,APCLVD,?45,APCLCLN,?49,APCLFAC S (APCLFRST,APCLP)=0
F S APCLP=$O(^AUPNVPOV("AD",APCLVER,APCLP)) Q:APCLP'=+APCLP D
.W:APCLFRST !
.S APCLFRST=APCLFRST+1
.W ?54,$P($$ICDDX^ICDEX($P(^AUPNVPOV(APCLP,0),U),0),U,2) W:$P(^AUPNVPOV(APCLP,0),U,4)]"" ?64,$E($$VAL^XBDIQ1(9000010.07,APCLP,.04),1,16)
.Q
W !
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),U)
W !!,$P(^VA(200,DUZ,0),"^",2),?(80-$L(X)/2),X,?70,"Page ",APCLPG
W !?25,"HOSPITAL ADMISSIONS AFTER ER VISIT"
W !?18,"VISITS DATES: ",APCLBDD," TO ",APCLEDD
W !!?5,"NAME",?17,"HRCN",?28,"VISIT DATE&TIME",?45,"CLN",?49,"FAC",?54,"ICD",?64,"PROV NARRATIVE"
W !,$TR($J("",80)," ","-")
W !
Q
;
APCLER2P ; IHS/CMI/LAB - PRINT CLINIC VISITS ;
+1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
+2 ;
+3 ;
INIT ;
+1 SET APCLDT=$$FMTE^XLFDT(DT)
+2 SET Y=APCLBD
DO DD^%DT
SET APCLBDD=Y
SET Y=APCLED
DO DD^%DT
SET APCLEDD=Y
+3 SET APCLPG=0
+4 IF '$DATA(^XTMP("APCLER2",APCLJOB,APCLBTH))
DO HEAD
WRITE !,"No visits to report."
GOTO END
+5 ;
SET ;
+1 DO HEAD
+2 SET APCLVDFN=0
+3 FOR
SET APCLVDFN=$ORDER(^XTMP("APCLER2",APCLJOB,APCLBTH,APCLVDFN))
IF APCLVDFN=""!($DATA(APCLQUIT))
QUIT
DO SET2
END ;
+1 DO DONE^APCLOSUT
+2 KILL ^XTMP("APCLER2",APCLJOB,APCLBTH)
+3 QUIT
SET2 ;
+1 SET APCLVER=^XTMP("APCLER2",APCLJOB,APCLBTH,APCLVDFN)
+2 SET APCLVREC=^AUPNVSIT(APCLVDFN,0)
+3 SET APCLHRCN=$SELECT($DATA(^AUPNPAT($PIECE(APCLVREC,U,5),41,DUZ(2),0)):$JUSTIFY($PIECE(^AUTTLOC(DUZ(2),0),U,7),4)_" "_$PIECE(^AUPNPAT($PIECE(APCLVREC,U,5),41,DUZ(2),0),U,2),1:"<NONE>")
PRN ;
+1 SET APCLNAME=$EXTRACT($PIECE(^DPT($PIECE(APCLVREC,U,5),0),U),1,15)
+2 KILL ^UTILITY("DIQ1",$JOB)
SET DIC=9000001
SET DA=$PIECE(APCLVREC,U,5)
SET DR=1102.99
DO EN^DIQ1
+3 SET APCLAGE=$GET(^UTILITY("DIQ1",$JOB,9000001,$PIECE(APCLVREC,U,5),1102.99))
KILL ^UTILITY("DIQ1",$JOB)
+4 SET APCLVD=$EXTRACT($PIECE(APCLVREC,U),4,5)_"/"_$EXTRACT($PIECE(APCLVREC,U),6,7)_"/"_$EXTRACT($PIECE(APCLVREC,U),2,3)
SET Y=$PIECE(APCLVREC,U)
DO DD^%DT
SET APCLVD=APCLVD_" "_$PIECE(Y,"@",2)
+5 SET APCLFAC=$PIECE(^AUTTLOC($PIECE(APCLVREC,U,6),0),U,7)
PRINT1 ;
+1 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+2 WRITE !,APCLNAME,?16,APCLHRCN,?28,APCLVD,?45,?49,APCLFAC
SET APCLFRST=0
SET APCLP=0
+3 FOR
SET APCLP=$ORDER(^AUPNVPOV("AD",APCLVDFN,APCLP))
IF APCLP'=+APCLP
QUIT
Begin DoDot:1
+4 IF APCLFRST
WRITE !
+5 SET APCLFRST=APCLFRST+1
+6 WRITE ?54,$PIECE($$ICDDX^ICDEX($PIECE(^AUPNVPOV(APCLP,0),U)),U,2)
IF $PIECE(^AUPNVPOV(APCLP,0),U,4)]""
WRITE ?64,$EXTRACT($$VAL^XBDIQ1(9000010.07,APCLP,.04),1,16)
End DoDot:1
PRINT2 ;
+1 SET APCLVD=$EXTRACT($PIECE(^AUPNVSIT(APCLVER,0),U),4,5)_"/"_$EXTRACT($PIECE(^AUPNVSIT(APCLVER,0),U),6,7)_"/"_$EXTRACT($PIECE(^AUPNVSIT(APCLVER,0),U),2,3)
SET Y=$PIECE(^AUPNVSIT(APCLVER,0),U)
DO DD^%DT
SET APCLVD=APCLVD_" "_$PIECE(Y,"@",2)
+2 SET APCLCLN=$SELECT($PIECE(^AUPNVSIT(APCLVER,0),U,8):$PIECE(^DIC(40.7,$PIECE(^AUPNVSIT(APCLVER,0),U,8),0),U,2),1:"--")
+3 SET APCLFAC=$SELECT($PIECE(^AUPNVSIT(APCLVER,0),U,6):$PIECE(^AUTTLOC($PIECE(^AUPNVSIT(APCLVER,0),U,6),0),U,7),1:"--")
+4 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+5 WRITE !?3,"ER Visit Information =>",?28,APCLVD,?45,APCLCLN,?49,APCLFAC
SET (APCLFRST,APCLP)=0
+6 FOR
SET APCLP=$ORDER(^AUPNVPOV("AD",APCLVER,APCLP))
IF APCLP'=+APCLP
QUIT
Begin DoDot:1
+7 IF APCLFRST
WRITE !
+8 SET APCLFRST=APCLFRST+1
+9 WRITE ?54,$PIECE($$ICDDX^ICDEX($PIECE(^AUPNVPOV(APCLP,0),U),0),U,2)
IF $PIECE(^AUPNVPOV(APCLP,0),U,4)]""
WRITE ?64,$EXTRACT($$VAL^XBDIQ1(9000010.07,APCLP,.04),1,16)
+10 QUIT
End DoDot:1
+11 WRITE !
+12 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),U)
+4 WRITE !!,$PIECE(^VA(200,DUZ,0),"^",2),?(80-$LENGTH(X)/2),X,?70,"Page ",APCLPG
+5 WRITE !?25,"HOSPITAL ADMISSIONS AFTER ER VISIT"
+6 WRITE !?18,"VISITS DATES: ",APCLBDD," TO ",APCLEDD
+7 WRITE !!?5,"NAME",?17,"HRCN",?28,"VISIT DATE&TIME",?45,"CLN",?49,"FAC",?54,"ICD",?64,"PROV NARRATIVE"
+8 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+9 WRITE !
+10 QUIT
+11 ;
