Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCDEFC

APCDEFC.m

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