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

APCLNJ21.m

Go to the documentation of this file. 
  1. APCLNJ21 ; IHS/CMI/LAB - PRINT CLINIC VISITS (CALC) ;
  1.  ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
  1.  ;
  1.  ;cmi/anch/maw 9/10/2007 code set versioning in POV
  1.  ;
  1. CALC ;find visits by date then store by patient name
  1.  D XTMP^APCLOSUT("APCLNJ2","PCC INJURY REPORT 2")
  1.  ;
  1.  S APCLJOB=$J,APCLBT=$H
  1.  S APCLVDT=APCLBD-.0001
  1. VST S APCLVDT=$O(^AUPNVSIT("B",APCLVDT))
  1.  G NEXT:APCLVDT="",NEXT:APCLVDT>(APCLED+.2359) S APCLVDFN=0
  1. VST1 S APCLVDFN=$O(^AUPNVSIT("B",APCLVDT,APCLVDFN)) G VST:APCLVDFN=""
  1.  ;
  1.  G VST1:'$D(^AUPNVSIT(APCLVDFN,0)) S APCLSTR=^(0)
  1.  G VST1:$P(APCLSTR,"^",11) ;screen out deleted visits
  1.  G VST1:$P(APCLSTR,U,5)=""
  1.  G VST1:$P(APCLSTR,U,6)=""
  1.  G VST1:$P(APCLSTR,U,7)=""
  1.  G VST1:$P(APCLSTR,U,3)=""
  1.  G VST1:$$DEMO^APCLUTL($P(APCLSTR,U,5),$G(APCLDEMO))
  1.  I $D(APCLLOCT),'$D(APCLLOCT($P(APCLSTR,U,6))) G VST1
  1.  I $D(APCLSCT),'$D(APCLSCT($P(APCLSTR,U,7))) G VST1
  1.  I $D(APCLTYPT),'$D(APCLTYPT($P(APCLSTR,U,3))) G VST1
  1.  I $D(APCLCLNT),$P(APCLSTR,U,8)="" G VST1
  1.  I $D(APCLCLNT),'$D(APCLCLNT($P(APCLSTR,U,8))) G VST1
  1.  I $D(APCLAGET),$$AGE^AUPNPAT($P(APCLSTR,U,5))>$P(APCLAGET,"-",2) G VST1
  1.  I $D(APCLAGET),$$AGE^AUPNPAT($P(APCLSTR,U,5))<$P(APCLAGET,"-",1) G VST1
  1.  ;
  1.  S APCLDFN=$P(APCLSTR,"^",5)
  1.  G VST1:'$D(^DPT(APCLDFN,0))
  1.  S APCLNAME=$P(^DPT(APCLDFN,0),"^")
  1.  D POV
  1.  G VST1
  1.  ;
  1. NEXT ;
  1.  S APCLET=$H
  1.  Q
  1.  ;
  1. POV ;check to see if pov is injury
  1.  ;IHS/CMI/LAB - patched line below
  1.  ;NEW X S X=0 F  S X=$O(^AUPNVPOV("AD",APCLVDFN,X)) Q:X'=+X  I $P(^ICD9(+^AUPNVPOV(X,0),0),U)>799.999 D  ;cmi/anch/maw 9/10/2007 orig line
  1.  NEW X S X=0 F  S X=$O(^AUPNVPOV("AD",APCLVDFN,X)) Q:X'=+X  S %=$P(^AUPNVPOV(X,0),U) I $$INJ^APCDAPOV(%,1)!($$INJ^APCDAPOV(%,30)) D  ;cmi/anch/maw 9/10/2007 csv
  1.  .S APCLGOT=0
  1.  .S APCLCIEN=$P($G(^AUPNVPOV(X,0)),U,9)
  1.  .Q:'$D(APCLCIEN)
  1.  .S APCLALC=$P($G(^AUPNVPOV(X,0)),U,7)
  1.  .F APCLX=1:1:18 S Y="TAX"_APCLX S APCLY=$T(@Y) Q:APCLGOT  D  S:'$D(APCLCNTR(APCLX,APCLZ)) APCLCNTR(APCLX,APCLZ)="0^0"
  1.  ..S APCLTXN=$P(APCLY,";;",3)
  1.  ..S APCLZ=$P(APCLY,";;",2)
  1.  ..S APCLTAX=$O(^ATXAX("B",APCLTXN,0))
  1.  ..S %=$$ICD^ATXAPI(APCLCIEN,APCLTAX,9)
  1.  ..Q:'%
  1.  ..S APCLGOT=1
  1.  ..S:'$D(APCLCNTR(APCLX,APCLZ)) APCLCNTR(APCLX,APCLZ)="0^0"
  1.  ..S $P(APCLCNTR(APCLX,APCLZ),U)=$P(APCLCNTR(APCLX,APCLZ),U)+1
  1.  ..I APCLALC=2 S $P(APCLCNTR(APCLX,APCLZ),U,2)=$P(APCLCNTR(APCLX,APCLZ),U,2)+1
  1.  ..I '$D(APCLGTOT) S APCLGTOT=0
  1.  ..S APCLGTOT=APCLGTOT+1
  1.  ..I '$D(APCLATOT) S APCLATOT=0
  1.  ..I APCLALC=2 S APCLATOT=APCLATOT+1
  1.  ..Q
  1.  .Q
  1.  ;I APCLGOT=0 S APCLNONE=1
  1.  Q
  1.  ;
  1. TAX1 ;;MOTOR VEHICLE;;APCL INJ MOTOR
  1. TAX2 ;;WATER TRANSPORT;;APCL INJ WATER TRANSPORT
  1. TAX3 ;;AIR TRANSPORT;;APCL INJ AIR TRANSPORT
  1. TAX4 ;;ACCIDENTAL POISONING;;APCL INJ POISONING
  1. TAX5 ;;ACCIDENTAL FALLS;;APCL INJ FALLS
  1. TAX6 ;;FIRES/FLAMES;;APCL INJ FIRE
  1. TAX7 ;;ENVIRONMENTAL FACTORS;;APCL INJ ENVIRONMENTAL FACTORS
  1. TAX8 ;;STINGS/VENOMS;;APCL INJ STINGS VENOMS
  1. TAX9 ;;ANIMAL RELATED;;APCL INJ ANIMAL RELATED
  1. TAX10 ;;DROWN/SUBMERGE;;APCL INJ DROWNING
  1. TAX11 ;;CUT PIERCING OBJ;;APCL INJ CUT
  1. TAX12 ;;FIREARMS;;APCL INJ FIREARMS
  1. TAX13 ;;SPORTS INJURY;;APCL INJ SPORTS
  1. TAX14 ;;SUICIDE ATTEMPTS;;APCL INJ SUICIDE
  1. TAX15 ;;ASSAULTS;;APCL INJ ASSAULTS
  1. TAX16 ;;BATTERED CHILD;;APCL INJ BATTERED CHILD
  1. TAX17 ;;UNDETERMINED;;APCL INJ UNDETERMINED
  1. TAX18 ;;OTHER CAUSES;;APCL INJ OTHER CAUSES