APCDEFC1 ; IHS/CMI/LAB - APCD Auto Print PCC Encounter Form Compute ;
;;2.0;IHS PCC SUITE;;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.
;
;
VDXP ;EP-- v diagnostic procedure result to external
S APCDDXP=$$VAL^XBDIQ1(9999999.68,$P(APCDTREC,U),.01)
S APCDV=$P(APCDTREC,U,4)
S APCDDXP(APCDDXP)=APCDV
Q
;
VRAD ;EP-- v radiology to external
S APCDRAD=$$VAL^XBDIQ1(71,$P(APCDTREC,U),.01)
S APCDABN=$P(APCDTREC,U,5)
S APCDRAD(APCDRAD)=APCDABN
Q
;
VHF ;EP-- v health factors to external
S APCDHF=$$VAL^XBDIQ1(9999999.64,$P(APCDTREC,U),.01)
S APCDLS=$S($P(APCDTREC,U,4):$$EXTSET^XBFUNC(9000010.23,.04,$P(APCDTREC,U,4)),1:"")
S APCDHF(APCDHF)=APCDLS
Q
;
VMIC ;EP-- v microbiology to external
S APCDMIC=$$VAL^XBDIQ1(60,$P(APCDTREC,U),.01)
S APCDORG=$S($P(APCDTREC,U,4):$$VAL^XBDIQ1(61.2,$P(APCDTREC,U,4),.01),1:"")
S APCDMIC(APCDMIC)=APCDORG
Q
;
VBB ;EP-- v blood bank to external
S APCDBB=$$VAL^XBDIQ1(60,$P(APCDTREC,U),.01)
S APCDRES=$P(APCDTREC,U,4)
S APCDAB=$S($P(APCDTREC,U,5):$$VAL^XBDIQ1(61.3,$P(APCDTREC,U,5),.01),1:"")
S APCDBB(APCDBB)=APCDRES_U_APCDAB
Q
;
VPHN ;EP-- v public health nurse to external
S APCDTVDF=$G(APCDTREC)
S APCDREC0=$G(^AUPNVPHN(APCDTVDF,0))
S APCDREC1=$G(^AUPNVPHN(APCDTVDF,21))
S APCDREC2=$G(^AUPNVPHN(APCDTVDF,22))
S APCDREC3=$G(^AUPNVPHN(APCDTVDF,23))
S APCDREC4=$G(^AUPNVPHN(APCDTVDF,24))
S APCDPHN=$P(APCDREC0,U)
S APCDRES=$S($P(APCDREC0,U,4):$$EXTSET^XBFUNC(9000010.32,.04,$P(APCDREC0,U,4)),1:"")
S APCDLOI=$S($P(APCDREC0,U,5):$$EXTSET^XBFUNC(9000010.32,.05,$P(APCDREC0,U,5)),1:"")
S APCDTOD=$S($P(APCDREC0,U,6):$$EXTSET^XBFUNC(9000010.32,.06,$P(APCDREC0,U,6)),1:"")
S APCDPHN(APCDPHN)=APCDRES_U_APCDLOI_U_APCDTOD_U_APCDREC1_U_APCDREC2
S APCDPHN(APCDPHN)=APCDPHN(APCDPHN)_U_APCDREC3_U_APCDREC4
Q
;
VNT ;EP-- v narrative text to external
S APCDTVDF=$G(APCDTREC)
S APCDREC0=$G(^AUPNVNT(APCDTVDF,0))
S APCDNT=$$VAL^XBDIQ1(9999999.89,$P(APCDREC0,U),.01)
Q:'$D(^AUPNVNT(APCDTVDF,11,0))
K ^UTILITY($J,"W")
S APCDNDA=0 F S APCDNDA=$O(^AUPNVNT(APCDTVDF,11,APCDNDA)) Q:'APCDNDA D
. S X=$G(^AUPNVNT(APCDTVDF,11,APCDNDA,0))
. S DIWL=0,DIWR=80
. D ^DIWP
S APCDUDA="" F S APCDUDA=$O(^UTILITY($J,"W",APCDUDA)) Q:APCDUDA="" D
. S APCDVDA=0 F S APCDVDA=$O(^UTILITY($J,"W",APCDUDA,APCDVDA)) Q:'APCDVDA!(APCDUDA="") D
.. S APCDNT(APCDNT,APCDVDA)=$G(^UTILITY($J,"W",APCDUDA,APCDVDA,0))
Q
;
VIF ;EP -- infant feeding choice
S APCDTVDF=$G(APCDTREC)
S APCDINF=$$EXTSET^XBFUNC(9000010.44,.01,$P(APCDTREC,U,1))
S APCDINF(APCDINF)=""
Q
APCDEFC1 ; IHS/CMI/LAB - APCD Auto Print PCC Encounter Form Compute ;
+1 ;;2.0;IHS PCC SUITE;;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 ;
VDXP ;EP-- v diagnostic procedure result to external
+1 SET APCDDXP=$$VAL^XBDIQ1(9999999.68,$PIECE(APCDTREC,U),.01)
+2 SET APCDV=$PIECE(APCDTREC,U,4)
+3 SET APCDDXP(APCDDXP)=APCDV
+4 QUIT
+5 ;
VRAD ;EP-- v radiology to external
+1 SET APCDRAD=$$VAL^XBDIQ1(71,$PIECE(APCDTREC,U),.01)
+2 SET APCDABN=$PIECE(APCDTREC,U,5)
+3 SET APCDRAD(APCDRAD)=APCDABN
+4 QUIT
+5 ;
VHF ;EP-- v health factors to external
+1 SET APCDHF=$$VAL^XBDIQ1(9999999.64,$PIECE(APCDTREC,U),.01)
+2 SET APCDLS=$SELECT($PIECE(APCDTREC,U,4):$$EXTSET^XBFUNC(9000010.23,.04,$PIECE(APCDTREC,U,4)),1:"")
+3 SET APCDHF(APCDHF)=APCDLS
+4 QUIT
+5 ;
VMIC ;EP-- v microbiology to external
+1 SET APCDMIC=$$VAL^XBDIQ1(60,$PIECE(APCDTREC,U),.01)
+2 SET APCDORG=$SELECT($PIECE(APCDTREC,U,4):$$VAL^XBDIQ1(61.2,$PIECE(APCDTREC,U,4),.01),1:"")
+3 SET APCDMIC(APCDMIC)=APCDORG
+4 QUIT
+5 ;
VBB ;EP-- v blood bank to external
+1 SET APCDBB=$$VAL^XBDIQ1(60,$PIECE(APCDTREC,U),.01)
+2 SET APCDRES=$PIECE(APCDTREC,U,4)
+3 SET APCDAB=$SELECT($PIECE(APCDTREC,U,5):$$VAL^XBDIQ1(61.3,$PIECE(APCDTREC,U,5),.01),1:"")
+4 SET APCDBB(APCDBB)=APCDRES_U_APCDAB
+5 QUIT
+6 ;
VPHN ;EP-- v public health nurse to external
+1 SET APCDTVDF=$GET(APCDTREC)
+2 SET APCDREC0=$GET(^AUPNVPHN(APCDTVDF,0))
+3 SET APCDREC1=$GET(^AUPNVPHN(APCDTVDF,21))
+4 SET APCDREC2=$GET(^AUPNVPHN(APCDTVDF,22))
+5 SET APCDREC3=$GET(^AUPNVPHN(APCDTVDF,23))
+6 SET APCDREC4=$GET(^AUPNVPHN(APCDTVDF,24))
+7 SET APCDPHN=$PIECE(APCDREC0,U)
+8 SET APCDRES=$SELECT($PIECE(APCDREC0,U,4):$$EXTSET^XBFUNC(9000010.32,.04,$PIECE(APCDREC0,U,4)),1:"")
+9 SET APCDLOI=$SELECT($PIECE(APCDREC0,U,5):$$EXTSET^XBFUNC(9000010.32,.05,$PIECE(APCDREC0,U,5)),1:"")
+10 SET APCDTOD=$SELECT($PIECE(APCDREC0,U,6):$$EXTSET^XBFUNC(9000010.32,.06,$PIECE(APCDREC0,U,6)),1:"")
+11 SET APCDPHN(APCDPHN)=APCDRES_U_APCDLOI_U_APCDTOD_U_APCDREC1_U_APCDREC2
+12 SET APCDPHN(APCDPHN)=APCDPHN(APCDPHN)_U_APCDREC3_U_APCDREC4
+13 QUIT
+14 ;
VNT ;EP-- v narrative text to external
+1 SET APCDTVDF=$GET(APCDTREC)
+2 SET APCDREC0=$GET(^AUPNVNT(APCDTVDF,0))
+3 SET APCDNT=$$VAL^XBDIQ1(9999999.89,$PIECE(APCDREC0,U),.01)
+4 IF '$DATA(^AUPNVNT(APCDTVDF,11,0))
QUIT
+5 KILL ^UTILITY($JOB,"W")
+6 SET APCDNDA=0
FOR
SET APCDNDA=$ORDER(^AUPNVNT(APCDTVDF,11,APCDNDA))
IF 'APCDNDA
QUIT
Begin DoDot:1
+7 SET X=$GET(^AUPNVNT(APCDTVDF,11,APCDNDA,0))
+8 SET DIWL=0
SET DIWR=80
+9 DO ^DIWP
End DoDot:1
+10 SET APCDUDA=""
FOR
SET APCDUDA=$ORDER(^UTILITY($JOB,"W",APCDUDA))
IF APCDUDA=""
QUIT
Begin DoDot:1
+11 SET APCDVDA=0
FOR
SET APCDVDA=$ORDER(^UTILITY($JOB,"W",APCDUDA,APCDVDA))
IF 'APCDVDA!(APCDUDA="")
QUIT
Begin DoDot:2
+12 SET APCDNT(APCDNT,APCDVDA)=$GET(^UTILITY($JOB,"W",APCDUDA,APCDVDA,0))
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
VIF ;EP -- infant feeding choice
+1 SET APCDTVDF=$GET(APCDTREC)
+2 SET APCDINF=$$EXTSET^XBFUNC(9000010.44,.01,$PIECE(APCDTREC,U,1))
+3 SET APCDINF(APCDINF)=""
+4 QUIT
