- 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
