APCDEFC ; IHS/CMI/LAB - APCD Auto Print PCC Encounter Form Compute ;
;;2.0;IHS PCC SUITE;**2,4**;MAY 14, 2009
;
;This routine will compute the automated PCC encounter form for
;a particular visit. The visit IEN needs to be passed in for it
;to run. This will typically be called after data entry.
;
;
MAIN ;EP -- loop through temp and print out the data
I '$D(^XTMP(APCDJ,APCDH,"APCDEF")) Q
D SET
Q
;
SET ;-- set up the data to print
S APCDPOVC=0,APCDCPTC=0
S APCDATMP="^XTMP(APCDJ,APCDH,""APCDEF"")"
S APCDA=0 F S APCDA=$O(@APCDATMP@(APCDA)) Q:'APCDA D
. S APCDFN=0 F S APCDFN=$O(@APCDATMP@(APCDA,APCDFN)) Q:APCDFN="" D
.. S APCDIEN=0 F S APCDIEN=$O(@APCDATMP@(APCDA,APCDFN,APCDIEN)) Q:'APCDIEN D
... S APCDTREC=$G(@APCDATMP@(APCDA,APCDFN,APCDIEN))
... Q:$T(@APCDFN)=""
... D @APCDFN
Q
;
VMSR ;-- v measurement to external
S APCDT=$$VAL^XBDIQ1(9000010.01,APCDTREC,.01)
S APCDV=$$VAL^XBDIQ1(9000010.01,APCDTREC,.04)
S APCDMSR(APCDIEN)=APCDT_U_APCDV
Q:'$O(^AUPNVMSR(APCDTREC,5,0))
NEW X,Y,J
S J=""
S X=0 F S X=$O(^AUPNVMSR(APCDTREC,5,X)) Q:X'=+X S Y=$P($G(^AUPNVMSR(APCDTREC,5,X,0)),U) I Y S J=J_$P(^GMRD(120.52,Y,0),U,2)_"|"
S $P(APCDMSR(APCDIEN),U,3)=J
Q
;
VXAM ;-- v exam to external
S APCDT=$$VAL^XBDIQ1(9000010.13,APCDTREC,.01)
S APCDV=$$VAL^XBDIQ1(9000010.13,APCDTREC,.04)
S APCDXAM(APCDT)=APCDV
Q
;
VPOV ;-- v pov to external
S APCDPOVC=$G(APCDPOVC)+1
S APCDPOV=$$VAL^XBDIQ1(9000010.07,APCDTREC,.01)
S APCDPRVN=$$VAL^XBDIQ1(9000010.07,APCDTREC,.04)
S APCDPOV(APCDPOVC)=APCDPOV_U_APCDPRVN
S APCDP=3 F APCDX=.05,.06,.07,.09,.11,.13,.18,.19,.21 S $P(APCDPOV(APCDPOVC),U,APCDP)=$$VAL^XBDIQ1(9000010.07,APCDTREC,APCDX),APCDP=APCDP+1
K APCDP,APCDX,APCDPRVN
Q
;
VMED ;-- v med to external
S APCDMED=$$VAL^XBDIQ1(50,$P(APCDTREC,U),.01)
S APCDSIG=$P(APCDTREC,U,5)
S APCDQTY=$P(APCDTREC,U,6)
S APCDDP=$P(APCDTREC,U,7)
S APCDMED(APCDMED)=APCDSIG_U_APCDQTY_U_APCDDP
Q
;
VEYE ;-- v eye glass to external
S APCDRO=$$EXTSET^XBFUNC(9000010.04,1901,$P(APCDTREC,U))
S APCDRES=$P(APCDTREC,U,2)
S APCDREC=$P(APCDTREC,U,3)
S APCDREA=$P(APCDTREC,U,4)
S APCDLES=$P(APCDTREC,U,5)
S APCDLEC=$P(APCDTREC,U,6)
S APCDLEA=$P(APCDTREC,U,7)
S APCDRAR=$P(APCDTREC,U,8)
S APCDRAL=$P(APCDTREC,U,9)
S APCDES=$P(APCDTREC,U,10)
S APCDBR=$P(APCDTREC,U,11)
S APCDTM=$P(APCDTREC,U,12)
S APCDPDN=$P(APCDTREC,U,13)
S APCDPDF=$P(APCDTREC,U,14)
Q
;
VDEN ;-- v dental to external
S APCDADA=$$VAL^XBDIQ1(9999999.31,$P(APCDTREC,U),.01)
S APCDNOU=$P(APCDTREC,U,4)
S APCDOS=$S($P(APCDTREC,U,5):$$VAL^XBDIQ1(9002010.03,$P(APCDTREC,U,5),.01),1:"")
S APCDTS=$P(APCDTREC,U,6)
S APCDDEN(APCDADA)=APCDNOU_U_APCDOS_U_APCDTS
Q
;
VCPT ;--v cpt to external
S APCDCPTC=$G(APCDCPTC)+1
S APCDCPT=$$VAL^XBDIQ1(81,$P(APCDTREC,U),.01)
S APCDUNI=$P(APCDTREC,U,16)
I $P(APCDTREC,U,8)]"" S APCDMD1=$$VAL^XBDIQ1($S($$VERSION^XPDUTL("BCSV")>0:81.3,1:9999999.88),$P(APCDTREC,U,8),.01)
I $P(APCDTREC,U,9)]"" S APCDMD2=$$VAL^XBDIQ1($S($$VERSION^XPDUTL("BCSV")>0:81.3,1:9999999.88),$P(APCDTREC,U,9),.01)
S APCDCPT(APCDCPTC)=APCDCPT_U_APCDUNI_U_$G(APCDMD1)_U_$G(APCDMD2)
Q
VPRC ;-- v procedure to external
S APCDPRC=$$VAL^XBDIQ1(80.1,$P(APCDTREC,U),.01)
S APCDPRN=$S($P(APCDTREC,U,4):$$VAL^XBDIQ1(9999999.27,$P(APCDTREC,U,4),.01),1:"")
S APCDPDT=$$FMTE^XLFDT($P(APCDTREC,U,6))
S APCDPRC(APCDPRC)=APCDPRN_U_APCDPDT
Q
;
VLAB ;-- v lab to external
S APCDLAB=$$VAL^XBDIQ1(60,$P(APCDTREC,U),.01)
S APCDRES=$P(APCDTREC,U,4)
S APCDABN=$P(APCDTREC,U,5)
S APCDLAB(APCDLAB)=APCDRES_U_APCDABN
Q
;
VIMM ;-- v immunization to external
S APCDIMM=$$VAL^XBDIQ1(9999999.14,$P(APCDTREC,U),.01)
S APCDSER=$S($P(APCDTREC,U,4)]"":$$EXTSET^XBFUNC(9000010.11,.04,$P(APCDTREC,U,4)),1:"")
S APCDLOT=$S($P(APCDTREC,U,5):$$VAL^XBDIQ1(9999999.41,$P(APCDTREC,U,5),.01),1:"")
S APCDREA=$S($P(APCDTREC,U,6):$$VAL^XBDIQ1(9002084.8,$P(APCDTREC,U,6),.01),1:"")
S APCDDOSE=$S($P(APCDTREC,U,8):$$EXTSET^XBFUNC(9000010.11,.08,$P(APCDTREC,U,8)),1:"")
S APCDINJ=$S($P(APCDTREC,U,9)]"":$$EXTSET^XBFUNC(9000010.11,.09,$P(APCDTREC,U,9)),1:"")
S APCDVOL=$P(APCDTREC,U,11)
S APCDVDAT=$$FMTE^XLFDT($P(APCDTREC,U,12))
S APCDIMM(APCDIMM)=APCDSER_U_APCDLOT_U_APCDREA_U_APCDDOSE_U_APCDINJ_U_APCDVOL_U_APCDVDAT
Q
;
VSK ;-- v skin test to external
S APCDSK=$$VAL^XBDIQ1(9999999.28,$P(APCDTREC,U),.01)
S APCDRES=$S($P(APCDTREC,U,4)]"":$$EXTSET^XBFUNC(9000010.12,.04,$P(APCDTREC,U,4)),1:"")
S APCDREA=$P(APCDTREC,U,5)
S APCDDTR=$$FMTE^XLFDT($P(APCDTREC,U,6))
S APCDREAD=$S($P(APCDTREC,U,8):$$VAL^XBDIQ1(200,$P(APCDTREC,U,8),.01),1:"")
S APCDINJ=$S($P(APCDTREC,U,9)]"":$$EXTSET^XBFUNC(9000010.12,.09,$P(APCDTREC,U,9)),1:"")
S APCDVOL=$P(APCDTREC,U,11)
S APCDSK(APCDSK)=APCDRES_U_APCDREA_U_APCDDTR_U_APCDREAD_U_APCDINJ_U_APCDVOL
Q
;
VTRT ;-- v treatment to external
S APCDTRT=$$VAL^XBDIQ1(9999999.17,$P(APCDTREC,U),.01)
S APCDHM=$P(APCDTREC,U,4)
S APCDPRV=$P(APCDTREC,U,5)
I APCDPRV S APCDPRV=$S($P(^DD(9000010.15,.05,0),U,2)[200:$P(^VA(200,$P(APCDTREC,U,5),0),U),1:$P(^DIC(16,$P(APCDTREC,U,5),0),U))
S APCDTRT(APCDTRT)=APCDHM_U_APCDPRV
Q
;
VPED ;-- v patient education to external
S APCDPED=$$VAL^XBDIQ1(9000010.16,APCDTREC,.01)
S APCDC=1 F APCDX=".06",".07",".08",".09",".11",".13",".14","1101","1102" S $P(APCDPED(APCDPED),U,APCDC)=$$VAL^XBDIQ1(9000010.16,APCDTREC,APCDX),APCDC=APCDC+1
Q
;
VPT ;-- v physical therapy to external
S APCDPT=$$VAL^XBDIQ1(9999999.46,$P(APCDTREC,U),.02)
S APCDQTY=$P(APCDTREC,U,4)
S APCDPT(APCDPT)=APCDQTY
Q
;
VACT ;-- v activity time to external
S APCDACT=$P(APCDTREC,U)
S APCDTT=$P(APCDTREC,U,4)
S APCDACT(APCDACT)=APCDTT
Q
;
VDXP ;-- v diagnostic procedure result to external
D VDXP^APCDEFC1
Q
;
VRAD ;-- v radiology to external
D VRAD^APCDEFC1
Q
;
VHF ;-- v health factors to external
D VHF^APCDEFC1
Q
;
VMIC ;-- v microbiology to external
D VMIC^APCDEFC1
Q
;
VBB ;-- v blood bank to external
D VBB^APCDEFC1
Q
;
VPHN ;-- v public health nurse to external
D VPHN^APCDEFC1
Q
;
VNT ;-- v narrative text to external
D VNT^APCDEFC1
Q
;
VIF ;-- v infant feeding
D VIF^APCDEFC1
Q
APCDEFC ; IHS/CMI/LAB - APCD Auto Print PCC Encounter Form Compute ;
+1 ;;2.0;IHS PCC SUITE;**2,4**;MAY 14, 2009
+2 ;
+3 ;This routine will compute the automated PCC encounter form for
+4 ;a particular visit. The visit IEN needs to be passed in for it
+5 ;to run. This will typically be called after data entry.
+6 ;
+7 ;
MAIN ;EP -- loop through temp and print out the data
+1 IF '$DATA(^XTMP(APCDJ,APCDH,"APCDEF"))
QUIT
+2 DO SET
+3 QUIT
+4 ;
SET ;-- set up the data to print
+1 SET APCDPOVC=0
SET APCDCPTC=0
+2 SET APCDATMP="^XTMP(APCDJ,APCDH,""APCDEF"")"
+3 SET APCDA=0
FOR
SET APCDA=$ORDER(@APCDATMP@(APCDA))
IF 'APCDA
QUIT
Begin DoDot:1
+4 SET APCDFN=0
FOR
SET APCDFN=$ORDER(@APCDATMP@(APCDA,APCDFN))
IF APCDFN=""
QUIT
Begin DoDot:2
+5 SET APCDIEN=0
FOR
SET APCDIEN=$ORDER(@APCDATMP@(APCDA,APCDFN,APCDIEN))
IF 'APCDIEN
QUIT
Begin DoDot:3
+6 SET APCDTREC=$GET(@APCDATMP@(APCDA,APCDFN,APCDIEN))
+7 IF $TEXT(@APCDFN)=""
QUIT
+8 DO @APCDFN
End DoDot:3
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
VMSR ;-- v measurement to external
+1 SET APCDT=$$VAL^XBDIQ1(9000010.01,APCDTREC,.01)
+2 SET APCDV=$$VAL^XBDIQ1(9000010.01,APCDTREC,.04)
+3 SET APCDMSR(APCDIEN)=APCDT_U_APCDV
+4 IF '$ORDER(^AUPNVMSR(APCDTREC,5,0))
QUIT
+5 NEW X,Y,J
+6 SET J=""
+7 SET X=0
FOR
SET X=$ORDER(^AUPNVMSR(APCDTREC,5,X))
IF X'=+X
QUIT
SET Y=$PIECE($GET(^AUPNVMSR(APCDTREC,5,X,0)),U)
IF Y
SET J=J_$PIECE(^GMRD(120.52,Y,0),U,2)_"|"
+8 SET $PIECE(APCDMSR(APCDIEN),U,3)=J
+9 QUIT
+10 ;
VXAM ;-- v exam to external
+1 SET APCDT=$$VAL^XBDIQ1(9000010.13,APCDTREC,.01)
+2 SET APCDV=$$VAL^XBDIQ1(9000010.13,APCDTREC,.04)
+3 SET APCDXAM(APCDT)=APCDV
+4 QUIT
+5 ;
VPOV ;-- v pov to external
+1 SET APCDPOVC=$GET(APCDPOVC)+1
+2 SET APCDPOV=$$VAL^XBDIQ1(9000010.07,APCDTREC,.01)
+3 SET APCDPRVN=$$VAL^XBDIQ1(9000010.07,APCDTREC,.04)
+4 SET APCDPOV(APCDPOVC)=APCDPOV_U_APCDPRVN
+5 SET APCDP=3
FOR APCDX=.05,.06,.07,.09,.11,.13,.18,.19,.21
SET $PIECE(APCDPOV(APCDPOVC),U,APCDP)=$$VAL^XBDIQ1(9000010.07,APCDTREC,APCDX)
SET APCDP=APCDP+1
+6 KILL APCDP,APCDX,APCDPRVN
+7 QUIT
+8 ;
VMED ;-- v med to external
+1 SET APCDMED=$$VAL^XBDIQ1(50,$PIECE(APCDTREC,U),.01)
+2 SET APCDSIG=$PIECE(APCDTREC,U,5)
+3 SET APCDQTY=$PIECE(APCDTREC,U,6)
+4 SET APCDDP=$PIECE(APCDTREC,U,7)
+5 SET APCDMED(APCDMED)=APCDSIG_U_APCDQTY_U_APCDDP
+6 QUIT
+7 ;
VEYE ;-- v eye glass to external
+1 SET APCDRO=$$EXTSET^XBFUNC(9000010.04,1901,$PIECE(APCDTREC,U))
+2 SET APCDRES=$PIECE(APCDTREC,U,2)
+3 SET APCDREC=$PIECE(APCDTREC,U,3)
+4 SET APCDREA=$PIECE(APCDTREC,U,4)
+5 SET APCDLES=$PIECE(APCDTREC,U,5)
+6 SET APCDLEC=$PIECE(APCDTREC,U,6)
+7 SET APCDLEA=$PIECE(APCDTREC,U,7)
+8 SET APCDRAR=$PIECE(APCDTREC,U,8)
+9 SET APCDRAL=$PIECE(APCDTREC,U,9)
+10 SET APCDES=$PIECE(APCDTREC,U,10)
+11 SET APCDBR=$PIECE(APCDTREC,U,11)
+12 SET APCDTM=$PIECE(APCDTREC,U,12)
+13 SET APCDPDN=$PIECE(APCDTREC,U,13)
+14 SET APCDPDF=$PIECE(APCDTREC,U,14)
+15 QUIT
+16 ;
VDEN ;-- v dental to external
+1 SET APCDADA=$$VAL^XBDIQ1(9999999.31,$PIECE(APCDTREC,U),.01)
+2 SET APCDNOU=$PIECE(APCDTREC,U,4)
+3 SET APCDOS=$SELECT($PIECE(APCDTREC,U,5):$$VAL^XBDIQ1(9002010.03,$PIECE(APCDTREC,U,5),.01),1:"")
+4 SET APCDTS=$PIECE(APCDTREC,U,6)
+5 SET APCDDEN(APCDADA)=APCDNOU_U_APCDOS_U_APCDTS
+6 QUIT
+7 ;
VCPT ;--v cpt to external
+1 SET APCDCPTC=$GET(APCDCPTC)+1
+2 SET APCDCPT=$$VAL^XBDIQ1(81,$PIECE(APCDTREC,U),.01)
+3 SET APCDUNI=$PIECE(APCDTREC,U,16)
+4 IF $PIECE(APCDTREC,U,8)]""
SET APCDMD1=$$VAL^XBDIQ1($SELECT($$VERSION^XPDUTL("BCSV")>0:81.3,1:9999999.88),$PIECE(APCDTREC,U,8),.01)
+5 IF $PIECE(APCDTREC,U,9)]""
SET APCDMD2=$$VAL^XBDIQ1($SELECT($$VERSION^XPDUTL("BCSV")>0:81.3,1:9999999.88),$PIECE(APCDTREC,U,9),.01)
+6 SET APCDCPT(APCDCPTC)=APCDCPT_U_APCDUNI_U_$GET(APCDMD1)_U_$GET(APCDMD2)
+7 QUIT
VPRC ;-- v procedure to external
+1 SET APCDPRC=$$VAL^XBDIQ1(80.1,$PIECE(APCDTREC,U),.01)
+2 SET APCDPRN=$SELECT($PIECE(APCDTREC,U,4):$$VAL^XBDIQ1(9999999.27,$PIECE(APCDTREC,U,4),.01),1:"")
+3 SET APCDPDT=$$FMTE^XLFDT($PIECE(APCDTREC,U,6))
+4 SET APCDPRC(APCDPRC)=APCDPRN_U_APCDPDT
+5 QUIT
+6 ;
VLAB ;-- v lab to external
+1 SET APCDLAB=$$VAL^XBDIQ1(60,$PIECE(APCDTREC,U),.01)
+2 SET APCDRES=$PIECE(APCDTREC,U,4)
+3 SET APCDABN=$PIECE(APCDTREC,U,5)
+4 SET APCDLAB(APCDLAB)=APCDRES_U_APCDABN
+5 QUIT
+6 ;
VIMM ;-- v immunization to external
+1 SET APCDIMM=$$VAL^XBDIQ1(9999999.14,$PIECE(APCDTREC,U),.01)
+2 SET APCDSER=$SELECT($PIECE(APCDTREC,U,4)]"":$$EXTSET^XBFUNC(9000010.11,.04,$PIECE(APCDTREC,U,4)),1:"")
+3 SET APCDLOT=$SELECT($PIECE(APCDTREC,U,5):$$VAL^XBDIQ1(9999999.41,$PIECE(APCDTREC,U,5),.01),1:"")
+4 SET APCDREA=$SELECT($PIECE(APCDTREC,U,6):$$VAL^XBDIQ1(9002084.8,$PIECE(APCDTREC,U,6),.01),1:"")
+5 SET APCDDOSE=$SELECT($PIECE(APCDTREC,U,8):$$EXTSET^XBFUNC(9000010.11,.08,$PIECE(APCDTREC,U,8)),1:"")
+6 SET APCDINJ=$SELECT($PIECE(APCDTREC,U,9)]"":$$EXTSET^XBFUNC(9000010.11,.09,$PIECE(APCDTREC,U,9)),1:"")
+7 SET APCDVOL=$PIECE(APCDTREC,U,11)
+8 SET APCDVDAT=$$FMTE^XLFDT($PIECE(APCDTREC,U,12))
+9 SET APCDIMM(APCDIMM)=APCDSER_U_APCDLOT_U_APCDREA_U_APCDDOSE_U_APCDINJ_U_APCDVOL_U_APCDVDAT
+10 QUIT
+11 ;
VSK ;-- v skin test to external
+1 SET APCDSK=$$VAL^XBDIQ1(9999999.28,$PIECE(APCDTREC,U),.01)
+2 SET APCDRES=$SELECT($PIECE(APCDTREC,U,4)]"":$$EXTSET^XBFUNC(9000010.12,.04,$PIECE(APCDTREC,U,4)),1:"")
+3 SET APCDREA=$PIECE(APCDTREC,U,5)
+4 SET APCDDTR=$$FMTE^XLFDT($PIECE(APCDTREC,U,6))
+5 SET APCDREAD=$SELECT($PIECE(APCDTREC,U,8):$$VAL^XBDIQ1(200,$PIECE(APCDTREC,U,8),.01),1:"")
+6 SET APCDINJ=$SELECT($PIECE(APCDTREC,U,9)]"":$$EXTSET^XBFUNC(9000010.12,.09,$PIECE(APCDTREC,U,9)),1:"")
+7 SET APCDVOL=$PIECE(APCDTREC,U,11)
+8 SET APCDSK(APCDSK)=APCDRES_U_APCDREA_U_APCDDTR_U_APCDREAD_U_APCDINJ_U_APCDVOL
+9 QUIT
+10 ;
VTRT ;-- v treatment to external
+1 SET APCDTRT=$$VAL^XBDIQ1(9999999.17,$PIECE(APCDTREC,U),.01)
+2 SET APCDHM=$PIECE(APCDTREC,U,4)
+3 SET APCDPRV=$PIECE(APCDTREC,U,5)
+4 IF APCDPRV
SET APCDPRV=$SELECT($PIECE(^DD(9000010.15,.05,0),U,2)[200:$PIECE(^VA(200,$PIECE(APCDTREC,U,5),0),U),1:$PIECE(^DIC(16,$PIECE(APCDTREC,U,5),0),U))
+5 SET APCDTRT(APCDTRT)=APCDHM_U_APCDPRV
+6 QUIT
+7 ;
VPED ;-- v patient education to external
+1 SET APCDPED=$$VAL^XBDIQ1(9000010.16,APCDTREC,.01)
+2 SET APCDC=1
FOR APCDX=".06",".07",".08",".09",".11",".13",".14","1101","1102"
SET $PIECE(APCDPED(APCDPED),U,APCDC)=$$VAL^XBDIQ1(9000010.16,APCDTREC,APCDX)
SET APCDC=APCDC+1
+3 QUIT
+4 ;
VPT ;-- v physical therapy to external
+1 SET APCDPT=$$VAL^XBDIQ1(9999999.46,$PIECE(APCDTREC,U),.02)
+2 SET APCDQTY=$PIECE(APCDTREC,U,4)
+3 SET APCDPT(APCDPT)=APCDQTY
+4 QUIT
+5 ;
VACT ;-- v activity time to external
+1 SET APCDACT=$PIECE(APCDTREC,U)
+2 SET APCDTT=$PIECE(APCDTREC,U,4)
+3 SET APCDACT(APCDACT)=APCDTT
+4 QUIT
+5 ;
VDXP ;-- v diagnostic procedure result to external
+1 DO VDXP^APCDEFC1
+2 QUIT
+3 ;
VRAD ;-- v radiology to external
+1 DO VRAD^APCDEFC1
+2 QUIT
+3 ;
VHF ;-- v health factors to external
+1 DO VHF^APCDEFC1
+2 QUIT
+3 ;
VMIC ;-- v microbiology to external
+1 DO VMIC^APCDEFC1
+2 QUIT
+3 ;
VBB ;-- v blood bank to external
+1 DO VBB^APCDEFC1
+2 QUIT
+3 ;
VPHN ;-- v public health nurse to external
+1 DO VPHN^APCDEFC1
+2 QUIT
+3 ;
VNT ;-- v narrative text to external
+1 DO VNT^APCDEFC1
+2 QUIT
+3 ;
VIF ;-- v infant feeding
+1 DO VIF^APCDEFC1
+2 QUIT
