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

IBDFRPC4.m

Go to the documentation of this file. 
  1. IBDFRPC4 ;ALB/AAS - AICS Pass data to PCE, Broker Call ; 24-FEB-96
  1.  ;;3.0;AUTOMATED INFO COLLECTION SYS;**38,36,37**;APR 24, 1997
  1.  ;
  1.  ; -- used by AICS Data Entry System, routine IBDFDE1
  1.  ;
  1. SEND(RESULT,IBDF) ; -- procedure
  1.  ; -- broker call to set data into pxca array and send to pce
  1.  ;    rpc  := IBD RECEIVE DATA
  1.  ;
  1.  ; -- input:      Result := passed by reference, see output
  1.  ;            ibdf(text) := contains data about visit, plus checkout defined as follows:
  1.  ;          ibdf("appt") := appointment data/time
  1.  ;        ibdf("clinic") := clinic, pointer to file 44
  1.  ;           ibdf("dfn") := patient, pointer to file 2
  1.  ;          ibdf("form") := encounter form ID, pointer to file 357.96
  1.  ;        ibdf("frmdef") := form definition, pointer to 357.95
  1.  ;       ibdf("foregnd") := pass data in foreground, show results
  1.  ;       ibdf("backgnd") := pass data in background, don't show results
  1.  ;
  1.  ;            ibdf("co") := check out date/time
  1.  ;            ibdf("sc") := is visit for service connected condition
  1.  ;            ibdf("ao") := is visit related to Agent orange
  1.  ;            ibdf("ir") := is visit related to ionizing radiation
  1.  ;            ibdf("ec") := is visit related to environmental contam.
  1.  ;            ibdf("mst"):= is visit related to Military Sexual Trauma
  1.  ;
  1.  ;               ibdf(n) := where n>0 are user selections as follows:
  1.  ;                   $p1 := package interface, pointer to file 357.6
  1.  ;                   $p2 := value to send
  1.  ;                   $p3 := display text
  1.  ;                   $p4 := header to send
  1.  ;                   $p5 := clin lexicon pointer
  1.  ;                   $p6 := qualifier
  1.  ;                   $p7 := ien of inteface
  1.  ;                   $p8 := vitals type (.01 field in 359.1)
  1.  ;                   $p9 := quantity
  1.  ;                      
  1.  N I,J,X,Y,D,D0,D1,D2,DA,DIC,DIE,DR,TNODE,FID,FORMID,NODE,VALUE,PI,TEXT,SUBHDR,HEADER,TYPE,QLFR,ITEM,PROVIDER,PXKDONE,STATUS,VSIT,QUANTITY,SDFN
  1.  S RESULT="-1^No data passed"
  1.  ;
  1.  K PXCA
  1.  S (PXCA,PXCASTAT)=""
  1.  ;
  1.  ; -- check form,frmdef and appt/clinic.  Need one or the other
  1.  S TNODE=$G(^IBD(357.96,+$G(IBDF("FORM")),0))
  1.  S:'$G(IBDF("DFN")) IBDF("DFN")=$P(TNODE,"^",2)
  1.  S:'$G(IBDF("APPT")) IBDF("APPT")=$P(TNODE,"^",3)
  1.  S:'$G(IBDF("FRMDEF")) IBDF("FRMDEF")=$P(TNODE,"^",4)
  1.  S:'$G(IBDF("CLINIC")) IBDF("CLINIC")=$P(TNODE,"^",10)
  1.  ;
  1.  I '$G(IBDF("DFN"))!('$G(IBDF("APPT")))!('$G(IBDF("CLINIC"))) D  G END
  1.  . I $G(IBDF("FORM")) S STATUS=$$FSCND^IBDF18C(+IBDF("FORM"),12)
  1.  . S RESULT="-1^Critical information for processing missing"
  1.  ;
  1.  ; -- log manual data entry attempt in form tracking
  1.  S STATUS=$$FSCND^IBDF18C(IBDF("FORM"),5)
  1.  ;
  1.  ; -- build the encounter node and source node from form tracking
  1.  S PXCA("ENCOUNTER")=$G(IBDF("APPT"))_"^"_$G(IBDF("DFN"))_"^"_$G(IBDF("CLINIC"))_"^^^"_$G(IBDF("SC"))_"^"_$G(IBDF("AO"))_"^"_$G(IBDF("IR"))_"^"_$G(IBDF("EC"))_"^"_$G(IBDF("MST"))_"^^^^"_$G(IBDF("CO"))
  1.  S PXCA("SOURCE")="1^"_DUZ_"^"_$G(IBDF("FRMDEF"))_"^^"_$G(IBDF("FORM"))
  1.  ;
  1.  ; -- process data in ibdf(n) nodes
  1.  S FORMID=IBDF("FORM")
  1.  S FID=0 F  S FID=$O(IBDF(FID)) Q:'FID  S NODE=$G(IBDF(FID)) D
  1.  .N VALUE,PI,TEXT,SUBHDR,HEADER,TYPE,QLFR,ITEM,DELEX,QUANTITY
  1.  .I NODE="" D LOGERR^IBDF18E2(3570002,.FORMID,FID) Q
  1.  .S PI=$P(NODE,"^")
  1.  .S VALUE=$$INPUT(PI,$P(NODE,"^",2))
  1.  .S TEXT=$P(NODE,"^",3)
  1.  .S (SUBHDR,HEADER)=$E($P(NODE,"^",4),1,80)
  1.  .I $L(SUBHDR),$L(SUBHDR)<2 S (SUBHDR,HEADER)=""
  1.  .;I $L(SUBHDR),($L(SUBHDR)+$L(TEXT)<80) S TEXT=SUBHDR_" "_TEXT
  1.  .S QLFR=$P(NODE,"^",6) S:QLFR'="" QLFR=$O(^IBD(357.98,"B",QLFR,0))
  1.  .S TYPE=+$$TYPE($P(NODE,"^",8))
  1.  .S ITEM=FID
  1.  .S DELEX=$P(NODE,"^",5)
  1.  .S QUANTITY=$P(NODE,"^",9)
  1.  .S SLCTN=$P(NODE,"^",12)
  1.  .D SETTEMP^IBDF18E1
  1.  .Q
  1.  ;
  1.  ; --added to copy visit modifiers
  1.  ;
  1.  D:$D(TEMP("ENCOUNTER")) VSTPXCA^IBDF18E0
  1.  ;
  1.  D SETPXCA^IBDF18E0,PRO^IBDF18E0
  1.  ;
  1.  ;  send misc. data that does not go to PCE
  1.  D ^IBDF18E4
  1.  ;
  1.  S IBDF("PASSFLAG")=+$P($G(^IBD(357.09,1,0)),"^",7)
  1.  S IBD("AICS")=1 ;flag for IBDF PCE EVENT protocal
  1.  ;
  1.  ;I $G(IBDF("PASSFLAG"))<1 D BACKGND^PXCA(.PXCA,.PXCASTAT)
  1.  ;I $G(IBDF("PASSFLAG"))=1 D VALIDATE^PXCA(.PXCA) I '$D(PXCA("ERROR")) D BACKGND^PXCA(.PXCA,.PXCASTAT)
  1.  I $G(IBDF("PASSFLAG"))<2 D QUE^IBDF18E3
  1.  I $G(IBDF("PASSFLAG"))>1 D FOREGND^PXCA(.PXCA,.PXCASTAT)
  1.  K IBD("AICS")
  1.  ;
  1.  ; -- kill erroneous inpatient warnings
  1.  I $D(PXCA("WARNING","ENCOUNTER"))>0 D INPT^IBDF18E0($G(IBDF("DFN")),$G(IBDF("APPT")))
  1.  ;
  1.  ; -- set form tracking processing status, if okay=6, if error=7
  1.  I $G(IBDF("FORM")) S STATUS=$$FSCND^IBDF18C(IBDF("FORM"),$S(PXCASTAT=0:7,PXCASTAT=1:6,PXCASTAT=-1:7,PXCASTAT=-2:6,1:12),$S((PXCASTAT=0!(PXCASTAT=-1)):"PCE RETURNED AN ERROR",1:""))
  1.  ;
  1.  S RESULT(0)=PXCASTAT
  1.  I (PXCASTAT=1!(PXCASTAT=-2)),IBDF("PASSFLAG")<3 K PXCA,PXCASTAT
  1. END Q
  1.  ;
  1. INPUT(PI,X) ; -- convert external value to internal value
  1.  I $G(PI)=""!($G(X)="")
  1.  I $G(^IBE(357.6,+$G(PI),9))'="" X ^(9)
  1. VALQ Q $G(X)
  1.  ;
  1. TYPE(X) ; -- Change external to internal for hand print fields
  1.  N Y S Y=""
  1.  I X'="" S Y=$O(^IBE(359.1,"B",X,0))
  1.  Q Y