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

APCD3MG.m

Go to the documentation of this file.
  1. APCD3MG ; IHS/CMI/LAB - install and generate HL7 messages to 3M ;
  1. ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1. ;
  1. ;
  1. OK3M(V) ;EP - check visit for 3M
  1. I '$G(V) Q "1^No visit ien passed"
  1. I '$D(^AUPNVSIT(V,0)) Q "2^Invalid Visit passed"
  1. I $P(^AUPNVSIT(V,0),"^",11) Q "3^Deleted visit passed"
  1. I '$P(^AUPNVSIT(V,0),"^",9) Q "4^Visit has no dependent entries"
  1. ;I '$D(^AUPNVPOV("AD",V)) Q "5^No POV for this visit"
  1. ;check all POVs for provider narrative
  1. ;NEW X,% S (X,%)=0 F S X=$O(^AUPNVPOV("AD",V,X)) Q:X'=+X I $P(^AUPNVPOV(X,0),"^",4)="" S %="6^No Provider Narrative on POV "_X
  1. S U="^"
  1. ;I % Q %
  1. ;NEW F S (F,X,%)=0 F S X=$O(^AUPNVPOV("AD",V,X)) Q:X'=+X!(F) I $$VAL^XBDIQ1(9000010.07,X,.01)=".9999",$P(^AUPNVPOV(X,0),"^",18)="" S F=1
  1. ;I 'F Q "13^No VPOV's with a .9999 diagnosis."
  1. NEW P S P=$P(^AUPNVSIT(V,0),"^",5)
  1. I 'P Q "7^No patient entered"
  1. I '$D(^DPT(P)) Q "8^Invalid DPT entry"
  1. I $P(^DPT(P,0),"^",2)="" Q "9^Sex of patient missing"
  1. I $P(^DPT(P,0),"^",3)="" Q "10^DOB of patient missing"
  1. NEW % S %="" D HOSPCHK I % Q %
  1. Q 0
  1. HOSPCHK ;
  1. Q:$P(^AUPNVSIT(V,0),"^",7)'="H"
  1. I '$D(^AUPNVINP("AD",V)) S %="11^No V HOSPITALIZATION Entry" Q
  1. NEW H S H=$O(^AUPNVINP("AD",V,""))
  1. I $P(^AUPNVINP(H,0),"^",6)="" S %="12^No discharge type entered on Hospitalization" Q
  1. Q
  1. ;
  1. GEN(APCDV) ;EP - generate HL7 message outbound to 3M
  1. K APCDHL7M
  1. S %=$$OK3M(APCDV) I $P(%,"^") S APCD3MER=% Q
  1. NEW % S %=$$OK3M(APCDV) I $P(%,"^") S APCD3MER=% Q
  1. Q
  1. ;