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

IBDFRPC1.m

Go to the documentation of this file.
  1. IBDFRPC1 ;ALB/AAS - Return list of selections ; 2-JAN-96
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;**25**;APR 24, 1997
  1. ;
  1. ; -- used by AICS Data Entry Systems, IBDFDE2, IBDFDE3, IBDFDE4
  1. ;
  1. OBJLST(RESULT,IBDF) ; -- Procedure
  1. ; -- Broker call to return any specified selection list, handprint field or multiple choice field
  1. ; rpc := IBD GET ONE INPUT OBJECT
  1. ;
  1. ; -- input RESULT := see output
  1. ; IBDF("PI") := package interface name or pointer
  1. ; IBDF("TYPE") := type of input object
  1. ; IBDF("IEN") := internal entry number of object
  1. ; IBDF("DFN") := pointer to patient (2) (required for patient active problems only)
  1. ; IBDF("CLINIC") := pointer to hospital location (44) (required for provider list only)
  1. ; IBDF("KILL") := 1 to kill results array prior to setting (Default) (optional)
  1. ;
  1. ; -- Output RESULT (called by reference)
  1. ; new for version 3.0 RESULT may be a closed global, i.e. ^tmp($j)
  1. ; and the data will be returned in ^tmp($j,n)
  1. ; For Lists:
  1. ; RESULT(0) := number of entries^type of input object (LIST)^qualifier;;selection rule[::qualifier;;selection rule)^no scannable bubbles(1 if not scannable)
  1. ; RESULTS(N) $P1 := Display text
  1. ; $P2 := Display code
  1. ; $P3 := input value (value to return)
  1. ; $P4 := input transform
  1. ; $P5 := optional caption
  1. ; $P6 := optional Term pointer
  1. ; $P7 := Selectable
  1. ;
  1. ; For Hand Print Fields
  1. ; RESULT(0) := 1^type of object (HP)^label^vitals type
  1. ; RESULT(1) := Text from form^print format in 359.1^MAX lenght^units^vitals Type^PCE DIM Units
  1. ;
  1. ; For Multiple Choice fields
  1. ; RESULT(0) := count of choices^type (MC)^display text^selection rule
  1. ; RESULT(n) := display text^label^value to return^qualifier^^^selectable (1)
  1. ;
  1. N IBQUIT,LIST,CLINIC,CL1,PI,PKG,PKG1,DYN,ARRY,VALUE
  1. S (IBQUIT,LIST)=0
  1. ;
  1. I $E($G(RESULT),1)="^" S ARRY=RESULT
  1. E S ARRY="RESULT"
  1. I $G(IBDF("KILL"))="" S IBDF("KILL")=1
  1. K:IBDF("KILL") @ARRY
  1. ;
  1. S @ARRY@(0)="No package Interface found, 1"
  1. ; -- set pkg = ien of pkg interface from either b or e x-ref
  1. S PKG=$G(IBDF("PI"))
  1. I +PKG'=PKG,PKG'="" S PKG1=+$O(^IBE(357.6,"B",$E(PKG,1,30),0)) I 'PKG1 S PKG1=+$O(^IBE(357.6,"E",$E(PKG,1,40),0))
  1. I $G(PKG1),'PKG S IBDF("PI")=PKG1
  1. G:'$G(IBDF("PI")) OBJLSTQ
  1. G:$G(^IBE(357.6,+IBDF("PI"),0))="" OBJLSTQ
  1. ;
  1. I $G(IBDF("TYPE"))="" D
  1. .S ITYP=$P($G(^IBE(357.6,+IBDF("PI"),0)),"^")
  1. .S IBDF("TYPE")=$S(ITYP=3:"LIST",ITYP=4:"MC",ITYP=5:"HP",1:"")
  1. I $G(IBDF("TYPE"))="" S @ARRY@(0)="Object Type not determined" G OBJLSTQ
  1. I "^LIST^MC^HP^"'[("^"_IBDF("TYPE")_"^") S @ARRY@(0)="Object type Unknown" G OBJLSTQ
  1. ;
  1. ;S FRM=$G(IBDF("FRM"))
  1. ;I +FRM'=FRM,FRM'="" S FRM=+$O(^IBE(357,"B",FRM,0))
  1. ;I 'FRM S FRM=$$DEFAULT^IBDFRPC S:FRM @ARRY@(0)="Using default form",IBDF("FRM")=FRM G:'FRM OBJLSTQ
  1. ;
  1. ; -- if type is selection list
  1. I IBDF("TYPE")="LIST" D G OBJLSTQ
  1. .S DYN=$P(^IBE(357.6,IBDF("PI"),0),"^",14)
  1. .I 'DYN D SEL^IBDFRPC2(.RESULT,.IBDF)
  1. .I DYN D DYN^IBDFRPC2(.RESULT,.IBDF)
  1. ;
  1. ; -- if type is multiple choice
  1. I IBDF("TYPE")="MC" D MC G OBJLSTQ
  1. ;
  1. ; -- If type is Hand Print
  1. I IBDF("TYPE")="HP" D HP G OBJLSTQ
  1. ;
  1. S @ARRY@(0)="Processing did not occur"
  1. ;
  1. OBJLSTQ Q
  1. ;
  1. MC ; -- returns list from multiple choice fields
  1. N X,DTEXT,SRULE,CHOICE,CH,CTEXT,CHLBL,CHID,CHQLF,CNT
  1. S @ARRY@(0)="Multiple Choice Field not found"
  1. G:'$G(IBDF("IEN")) MCQ
  1. S X=$G(^IBE(357.93,IBDF("IEN"),0)) G:X="" MCQ
  1. ;
  1. S DTEXT=$P(X,"^",2),SRULE=$P(X,"^",9)
  1. ;
  1. S (CHOICE,CNT)=0
  1. F S CHOICE=$O(^IBE(357.93,IBDF("IEN"),1,CHOICE)) Q:'CHOICE D
  1. .S CH=$G(^IBE(357.93,IBDF("IEN"),1,CHOICE,0)) Q:CH=""
  1. .S CTEXT=$P(CH,"^"),CHLBL=$P(CH,"^",5),CHID=$P(CH,"^",8)
  1. .S CHQLF=$P(CH,"^",9),VALUE=$P($G(^IBD(357.98,+$G(CHQLF),0)),"^")
  1. .S CNT=CNT+1
  1. .S @ARRY@(CNT)=CTEXT_"^"_CHLBL_"^"_VALUE_"^"_CHQLF_"^^^1"
  1. .Q
  1. S @ARRY@(0)=CNT_"^MC^"_DTEXT_"^"_SRULE
  1. MCQ Q
  1. ;
  1. HP ; -- returns information on hand print field
  1. N X,HNODE,HTEXT,HTYPE,HLEN,HPIC,HMEAS,VTYPE,VUNIT
  1. S @ARRY@(0)="Hand Print field not found"
  1. G:'$G(IBDF("IEN")) HPQ
  1. S HNODE=$G(^IBE(359.94,IBDF("IEN"),0))
  1. G:$G(HNODE)="" HPQ
  1. S HTEXT=$P(HNODE,"^",2)
  1. S HTYPE=$G(^IBE(359.1,+$P(HNODE,"^",10),0))
  1. S HLEN=$P(HTYPE,"^",2),HPIC=$$FRMT^IBDF2F(HTYPE,$G(IBAPPT)),HMEAS=$P(HTYPE,"^",11),VTYPE=$P(HTYPE,"^",12),VUNIT=$P(HTYPE,"^",13)
  1. S @ARRY@(1)=HTEXT_"^"_HPIC_"^"_HLEN_"^"_HMEAS_"^"_VTYPE_"^"_VUNIT
  1. S @ARRY@(0)="1^HP^"_HTEXT_"^0"
  1. ;
  1. HPQ Q
  1. ;
  1. 3 ; -- return lists of providers/cpts/diagnosis from form
  1. ; format as in 2
  1. Q
  1. ;
  1. 4 ; -- provide list of other input items/and parameters
  1. Q
  1. ;
  1. TESTD ; -- test dynamic list
  1. S IBDF("PI")=61
  1. S IBDF("IEN")=1729
  1. S IBDF("TYPE")="LIST"
  1. S IBDF("CLINIC")=300
  1. S IBDF("DFN")=1
  1. D OBJLST(.TEST,.IBDF)
  1. X "ZW TEST"
  1. Q
  1. ;
  1. TESTL ; -- test list
  1. K TEST
  1. S IBDF("PI")=7
  1. S IBDF("IEN")=488
  1. S IBDF("TYPE")="LIST"
  1. D OBJLST("^TMP($J,""TESTL"")",.IBDF)
  1. X "ZW TEST"
  1. Q
  1. ;
  1. TESTM ; -- test Multiple choice
  1. K TEST
  1. S IBDF("PI")=7
  1. S IBDF("TYPE")="MC"
  1. S IBDF("IEN")=161
  1. D OBJLST("^TMP($J,""TESTM"")",.IBDF)
  1. X "ZW TEST"
  1. Q
  1. TESTH ; -- test Hand Print
  1. K TEST
  1. S IBDF("PI")=95
  1. S IBDF("TYPE")="HP"
  1. S IBDF("IEN")=352
  1. D OBJLST(.TEST,.IBDF)
  1. X "ZW TEST"
  1. Q