APCDEWHA ; IHS/CMI/LAB - DISPLAY PATIENT & VISIT INFO ;
;;2.0;IHS PCC SUITE;**22**;MAY 14, 2009;Build 6
;CALLED FROM THE TEMPLATE APCD WHAT (WHA)
START ;EP
K APCDVREC
S:$D(APCDVDSP) APCDVREC=^AUPNVSIT(APCDVDSP,0)
W !!,"You are currently processing the following Patient",$S($D(APCDVDSP):" Visit",1:""),":",!!
S APCDH="Patient Name",APCDV=$E($P(^DPT(AUPNPAT,0),U),1,20) D WRITE
S APCDH="Chart #",APCDV=$S($D(^AUPNPAT(AUPNPAT,41,DUZ(2),0)):$P(^(0),U,2),1:"None") D WRITE
S APCDH="Date of Birth" S Y=AUPNDOB D DD^%DT S APCDV=Y D WRITE
S APCDH="Sex",APCDV=AUPNSEX D WRITE
G:'$D(APCDVREC) XIT
S APCDH="Visit Date" S Y=$P(APCDVREC,U) D DD^%DT S APCDV=Y D WRITE
S APCDH="Location",APCDV=$E($P(^DIC(4,$P(APCDVREC,U,6),0),U),1,25) D WRITE
S APCDH="Type",APCDV=$P(APCDVREC,U,3) D WRITE
S APCDH="Service Category",APCDV=$P(APCDVREC,U,7) D WRITE
S APCDH="Clinic",APCDV=$S($P(APCDVREC,U,8)="":"None Entered",1:$P(^DIC(40.7,$P(APCDVREC,U,8),0),U)) D WRITE
S APCDH="Hospital Location",APCDV=$$VAL^XBDIQ1(9000010,APCDVDSP,.22)
I $P(^AUPNVSIT(APCDVDSP,0),U,34)]"" S APCDH="DRG",APCDV=$$VAL^XBDIQ1(9000010,APCDVDSP,.34) D WRITE
I $P(^AUPNVSIT(APCDVDSP,0),U,35)]"" S APCDH="HCFA WT",APCDV=$$VAL^XBDIQ1(9000010,APCDVDSP,.35) D WRITE
I $P($G(^AUPNVSIT(APCDVDSP,12)),U,11)]"" S APCDH="Ext Acct #",APCDV=$P($G(^AUPNVSIT(APCDVDSP,12)),U,11) D WRITE
I $P($G(^AUPNVSIT(APCDVDSP,11)),U,3)]"" S APCDH="VCN",APCDV=$P($G(^AUPNVSIT(APCDVDSP,11)),U,3) D WRITE
I $G(^AUPNVSIT(APCDVDSP,21))]"" S APCDV=$P(^AUPNVSIT(APCDVDSP,21),U),APCDH="Outside Location" W ! D WRITE
I $P(APCDVREC,U,9) D DSPLY
;
XIT ; XIT CLEANUP
K APCDVDFN,APCDVDG,APCDVDSH,APCDVFLE,APCDVI,APCDVIGR,APCDVL,APCDVNM,X,Y,APCDVREC,APCDV,APCDH,APCDZ,APCDX,APCDY,APCDT
Q
DSPLY ;
NEW DA,D0,DIC,DIQ,DR,DI
S APCDVFLE=9000010 F APCDVL=0:0 S APCDVFLE=$O(^DIC(APCDVFLE)) Q:APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE) D DSPLY2
D XIT
Q
;
DSPLY2 ;
S APCDVNM=$P(^DIC(APCDVFLE,0),U),APCDVDG=^DIC(APCDVFLE,0,"GL"),APCDVIGR=APCDVDG_"""AD"",APCDVDSP,APCDVDFN)",APCDVDFN=""
F APCDVI=1:1 S APCDVDFN=$O(@APCDVIGR) Q:APCDVDFN="" D DSPLY3
Q
;
DSPLY3 ;
I APCDVFLE=9000010.01 Q:$P($G(^AUPNVMSR(APCDVDFN,2)),U,1) ;measurements entered in error
I APCDVFLE=9000010.54 Q:$P($G(^AUPNVRUP(APCDVDFN,2)),U,1) ;V updated/reviewed entered in error
I APCDVFLE=9000010.62 Q:$P($G(^AUPNVAMI(APCDVDFN,5)),U,1) ;V AMI entered in error
I APCDVFLE=9000010.63 Q:$P($G(^AUPNVSTR(APCDVDFN,5)),U,1) ;V STROKE entered in error
I APCDVFLE=9000010.51 Q:$P($G(^AUPNVACG(APCDVDFN,1)),U,1) ;V ANTICOAG entered in error
I APCDVFLE=9000010.58 Q:$P($G(^AUPNVVI(APCDVDFN,0)),U,6) ;V VISIT INSTRUCTIONS entered in error
I APCDVFLE=9000010.43 Q:$P($G(^AUPNVOB(APCDVDFN,0)),U,6) ;V OB entered in error
I APCDVFLE=9000010.64 Q:$P($G(^AUPNVDLV(APCDVDFN,5)),U,1) ;V DELIVERY entered in error PATCH 22
I APCDVI<2 S APCDX=20-$L($P(APCDVNM,"V ",2)_"'s"),APCDY=APCDX\2,APCDZ=APCDX-APCDY W !!,"==============",$J("",APCDZ),$P(APCDVNM,"V ",2)_"'s",$J("",APCDY),"=============="
I APCDVI>1 W !
K ^UTILITY("DIQ1",$J)
I APCDVFLE'=9000010.09 S DIC=APCDVDG,DR=".01;.04:99999",(DA,D0)=APCDVDFN D EN^DIQ1 ;IHS/CMI/LAB
I APCDVFLE=9000010.09 S DIC=APCDVDG,DR=".01;.04;1202",(DA,D0)=APCDVDFN D EN^DIQ1 ;IHS/CMI/LAB
D DSPLY4
Q
;
DSPLY4 ;
W !
F APCDY=0:0 S APCDY=$O(^UTILITY("DIQ1",$J,APCDVFLE,APCDVDFN,APCDY)) Q:'APCDY D
.I $G(^UTILITY("DIQ1",$J,APCDVFLE,APCDVDFN,APCDY))]"" S APCDX=$P(^DD(APCDVFLE,APCDY,0),U)_": "_^UTILITY("DIQ1",$J,APCDVFLE,APCDVDFN,APCDY) D DSPLY41 Q
.I $O(^UTILITY("DIQ1",$J,APCDVFLE,APCDVDFN,APCDY,0)) D
..S F=0 F S F=$O(^UTILITY("DIQ1",$J,APCDVFLE,APCDVDFN,APCDY,F)) Q:F'=+F S APCDX=^UTILITY("DIQ1",$J,APCDVFLE,APCDVDFN,APCDY,F) D DSPLY41
K APCDT,APCDX,APCDY
Q
DSPLY41 ;
W:$X>39 ! S APCDT=$S($X<2:$X,1:$X+5) W:(APCDT+$L(APCDX))>79 ! S:(APCDT+$L(APCDX))>79 APCDT=0 W ?APCDT,APCDX
Q
WRITE ;
S APCDV=" "_APCDV_" "
S APCDX=APCDH_": "_APCDV W:$X>39 ! S APCDT=$S($X>1:41,1:1) W:(APCDT+$L(APCDX))>79 ! W ?APCDT,APCDH,": ",@APCDRVON,APCDV,@APCDRVOF
K APCDT,APCDX
Q
APCDEWHA ; IHS/CMI/LAB - DISPLAY PATIENT & VISIT INFO ;
+1 ;;2.0;IHS PCC SUITE;**22**;MAY 14, 2009;Build 6
+2 ;CALLED FROM THE TEMPLATE APCD WHAT (WHA)
START ;EP
+1 KILL APCDVREC
+2 IF $DATA(APCDVDSP)
SET APCDVREC=^AUPNVSIT(APCDVDSP,0)
+3 WRITE !!,"You are currently processing the following Patient",$SELECT($DATA(APCDVDSP):" Visit",1:""),":",!!
+4 SET APCDH="Patient Name"
SET APCDV=$EXTRACT($PIECE(^DPT(AUPNPAT,0),U),1,20)
DO WRITE
+5 SET APCDH="Chart #"
SET APCDV=$SELECT($DATA(^AUPNPAT(AUPNPAT,41,DUZ(2),0)):$PIECE(^(0),U,2),1:"None")
DO WRITE
+6 SET APCDH="Date of Birth"
SET Y=AUPNDOB
DO DD^%DT
SET APCDV=Y
DO WRITE
+7 SET APCDH="Sex"
SET APCDV=AUPNSEX
DO WRITE
+8 IF '$DATA(APCDVREC)
GOTO XIT
+9 SET APCDH="Visit Date"
SET Y=$PIECE(APCDVREC,U)
DO DD^%DT
SET APCDV=Y
DO WRITE
+10 SET APCDH="Location"
SET APCDV=$EXTRACT($PIECE(^DIC(4,$PIECE(APCDVREC,U,6),0),U),1,25)
DO WRITE
+11 SET APCDH="Type"
SET APCDV=$PIECE(APCDVREC,U,3)
DO WRITE
+12 SET APCDH="Service Category"
SET APCDV=$PIECE(APCDVREC,U,7)
DO WRITE
+13 SET APCDH="Clinic"
SET APCDV=$SELECT($PIECE(APCDVREC,U,8)="":"None Entered",1:$PIECE(^DIC(40.7,$PIECE(APCDVREC,U,8),0),U))
DO WRITE
+14 SET APCDH="Hospital Location"
SET APCDV=$$VAL^XBDIQ1(9000010,APCDVDSP,.22)
+15 IF $PIECE(^AUPNVSIT(APCDVDSP,0),U,34)]""
SET APCDH="DRG"
SET APCDV=$$VAL^XBDIQ1(9000010,APCDVDSP,.34)
DO WRITE
+16 IF $PIECE(^AUPNVSIT(APCDVDSP,0),U,35)]""
SET APCDH="HCFA WT"
SET APCDV=$$VAL^XBDIQ1(9000010,APCDVDSP,.35)
DO WRITE
+17 IF $PIECE($GET(^AUPNVSIT(APCDVDSP,12)),U,11)]""
SET APCDH="Ext Acct #"
SET APCDV=$PIECE($GET(^AUPNVSIT(APCDVDSP,12)),U,11)
DO WRITE
+18 IF $PIECE($GET(^AUPNVSIT(APCDVDSP,11)),U,3)]""
SET APCDH="VCN"
SET APCDV=$PIECE($GET(^AUPNVSIT(APCDVDSP,11)),U,3)
DO WRITE
+19 IF $GET(^AUPNVSIT(APCDVDSP,21))]""
SET APCDV=$PIECE(^AUPNVSIT(APCDVDSP,21),U)
SET APCDH="Outside Location"
WRITE !
DO WRITE
+20 IF $PIECE(APCDVREC,U,9)
DO DSPLY
+21 ;
XIT ; XIT CLEANUP
+1 KILL APCDVDFN,APCDVDG,APCDVDSH,APCDVFLE,APCDVI,APCDVIGR,APCDVL,APCDVNM,X,Y,APCDVREC,APCDV,APCDH,APCDZ,APCDX,APCDY,APCDT
+2 QUIT
DSPLY ;
+1 NEW DA,D0,DIC,DIQ,DR,DI
+2 SET APCDVFLE=9000010
FOR APCDVL=0:0
SET APCDVFLE=$ORDER(^DIC(APCDVFLE))
IF APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE)
QUIT
DO DSPLY2
+3 DO XIT
+4 QUIT
+5 ;
DSPLY2 ;
+1 SET APCDVNM=$PIECE(^DIC(APCDVFLE,0),U)
SET APCDVDG=^DIC(APCDVFLE,0,"GL")
SET APCDVIGR=APCDVDG_"""AD"",APCDVDSP,APCDVDFN)"
SET APCDVDFN=""
+2 FOR APCDVI=1:1
SET APCDVDFN=$ORDER(@APCDVIGR)
IF APCDVDFN=""
QUIT
DO DSPLY3
+3 QUIT
+4 ;
DSPLY3 ;
+1 ;measurements entered in error
IF APCDVFLE=9000010.01
IF $PIECE($GET(^AUPNVMSR(APCDVDFN,2)),U,1)
QUIT
+2 ;V updated/reviewed entered in error
IF APCDVFLE=9000010.54
IF $PIECE($GET(^AUPNVRUP(APCDVDFN,2)),U,1)
QUIT
+3 ;V AMI entered in error
IF APCDVFLE=9000010.62
IF $PIECE($GET(^AUPNVAMI(APCDVDFN,5)),U,1)
QUIT
+4 ;V STROKE entered in error
IF APCDVFLE=9000010.63
IF $PIECE($GET(^AUPNVSTR(APCDVDFN,5)),U,1)
QUIT
+5 ;V ANTICOAG entered in error
IF APCDVFLE=9000010.51
IF $PIECE($GET(^AUPNVACG(APCDVDFN,1)),U,1)
QUIT
+6 ;V VISIT INSTRUCTIONS entered in error
IF APCDVFLE=9000010.58
IF $PIECE($GET(^AUPNVVI(APCDVDFN,0)),U,6)
QUIT
+7 ;V OB entered in error
IF APCDVFLE=9000010.43
IF $PIECE($GET(^AUPNVOB(APCDVDFN,0)),U,6)
QUIT
+8 ;V DELIVERY entered in error PATCH 22
IF APCDVFLE=9000010.64
IF $PIECE($GET(^AUPNVDLV(APCDVDFN,5)),U,1)
QUIT
+9 IF APCDVI<2
SET APCDX=20-$LENGTH($PIECE(APCDVNM,"V ",2)_"'s")
SET APCDY=APCDX\2
SET APCDZ=APCDX-APCDY
WRITE !!,"==============",$JUSTIFY("",APCDZ),$PIECE(APCDVNM,"V ",2)_"'s",$JUSTIFY("",APCDY),"=============="
+10 IF APCDVI>1
WRITE !
+11 KILL ^UTILITY("DIQ1",$JOB)
+12 ;IHS/CMI/LAB
IF APCDVFLE'=9000010.09
SET DIC=APCDVDG
SET DR=".01;.04:99999"
SET (DA,D0)=APCDVDFN
DO EN^DIQ1
+13 ;IHS/CMI/LAB
IF APCDVFLE=9000010.09
SET DIC=APCDVDG
SET DR=".01;.04;1202"
SET (DA,D0)=APCDVDFN
DO EN^DIQ1
+14 DO DSPLY4
+15 QUIT
+16 ;
DSPLY4 ;
+1 WRITE !
+2 FOR APCDY=0:0
SET APCDY=$ORDER(^UTILITY("DIQ1",$JOB,APCDVFLE,APCDVDFN,APCDY))
IF 'APCDY
QUIT
Begin DoDot:1
+3 IF $GET(^UTILITY("DIQ1",$JOB,APCDVFLE,APCDVDFN,APCDY))]""
SET APCDX=$PIECE(^DD(APCDVFLE,APCDY,0),U)_": "_^UTILITY("DIQ1",$JOB,APCDVFLE,APCDVDFN,APCDY)
DO DSPLY41
QUIT
+4 IF $ORDER(^UTILITY("DIQ1",$JOB,APCDVFLE,APCDVDFN,APCDY,0))
Begin DoDot:2
+5 SET F=0
FOR
SET F=$ORDER(^UTILITY("DIQ1",$JOB,APCDVFLE,APCDVDFN,APCDY,F))
IF F'=+F
QUIT
SET APCDX=^UTILITY("DIQ1",$JOB,APCDVFLE,APCDVDFN,APCDY,F)
DO DSPLY41
End DoDot:2
End DoDot:1
+6 KILL APCDT,APCDX,APCDY
+7 QUIT
DSPLY41 ;
+1 IF $X>39
WRITE !
SET APCDT=$SELECT($X<2:$X,1:$X+5)
IF (APCDT+$LENGTH(APCDX))>79
WRITE !
IF (APCDT+$LENGTH(APCDX))>79
SET APCDT=0
WRITE ?APCDT,APCDX
+2 QUIT
WRITE ;
+1 SET APCDV=" "_APCDV_" "
+2 SET APCDX=APCDH_": "_APCDV
IF $X>39
WRITE !
SET APCDT=$SELECT($X>1:41,1:1)
IF (APCDT+$LENGTH(APCDX))>79
WRITE !
WRITE ?APCDT,APCDH,": ",@APCDRVON,APCDV,@APCDRVOF
+3 KILL APCDT,APCDX
+4 QUIT
