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

IBDFRPC.m

Go to the documentation of this file.
  1. IBDFRPC ;ALB/AAS - AICS Return list of interfaces ; 2-JAN-96
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;**1,23**;APR 24, 1997
  1. ;
  1. CLNLSTI(RESULT,CLINIC) ; -- Procedure
  1. ; -- Broker call to return list of data entry elements for a clinic/patient/form
  1. ; rpc := IBD GET INPUT OBJECT BY CLINIC
  1. ;
  1. ; -- input CLINIC = pointer to hospital location file or clinic name
  1. ; Result = called by reference or use a closed global root
  1. ;
  1. ; -- output The format of the returned array is as follows
  1. ; result(0) := count of array elements
  1. ; result(n) := $p1 := pkg interface name
  1. ; $p2 := pkg interface ien
  1. ; $p3 := form name
  1. ; $p4 := form type
  1. ; $p5 := type of input object
  1. ; $p6 := input object ien.
  1. ; $P7 := Vital Name (vitals only)
  1. ; $p8 := manual data entry supported
  1. ; $p9 := Block ien
  1. ; $p10 := block row
  1. ; $p11 := block column
  1. ;
  1. N I,J,X,Y,CL1,FTYP,IBDX,FRM,CNT
  1. ;
  1. I $E($G(RESULT),1)="^" S ARRY=RESULT
  1. E S ARRY="RESULT"
  1. ;
  1. K @ARRY S @ARRY@(0)="Clinic Not Found"
  1. I +CLINIC'=CLINIC,CLINIC'="" S CLINIC=+$O(^SC("B",CLINIC,0))
  1. G:'CLINIC CLNLSTQ
  1. ;
  1. ; -- find forms for clinic in clinic set up
  1. ; if no form, use default form from parameters
  1. S CL1=$O(^SD(409.95,"B",CLINIC,0))
  1. I 'CL1 D G CLNLSTQ
  1. .S @ARRY@(0)="No forms for Clinic"
  1. .S FRM=$$DEFAULT Q:'FRM
  1. .S @ARRY@(0)="Using Default Form"
  1. .D FRMLSTI(.RESULT,FRM,11,0)
  1. ;
  1. S IBDX=$G(^SD(409.95,CL1,0)) F FTYP=2,3,4,5,6,8,9 I $P(IBDX,"^",FTYP)'="" S FRM=$P(IBDX,"^",FTYP) D FRMLSTI(.RESULT,FRM,FTYP,0)
  1. ;
  1. CLNLSTQ Q
  1. ;
  1. FRMLSTI(RESULT,FRM,FTYP,KILL,ALLOBJ) ; -- procedure
  1. ; -- Broker call to return list of data entry elemets for one form
  1. ; rpc := IBD GET INPUT OBJECT BY FORM
  1. ;
  1. ; -- input FRM := pointer to encounter form file (357) or form name
  1. ; Result := Call by reference or use a closed global root
  1. ; FTYP := type of form for clinic (optional)
  1. ; KILL := 1 to kill results array prior to setting (default) (optional)
  1. ; ALLOBJ := 1 to return all form objects, not just input objs
  1. ; 0 to not kill array
  1. ;
  1. ; -- output The format of the returned array is as follows
  1. ; Result(0) := count of array elements
  1. ; Result(n) $p1 := pkg interface name
  1. ; $p2 := pkg interface ien
  1. ; $p3 := form name
  1. ; $p4 := form type
  1. ; $p5 := type of input object
  1. ; $p6 := input object ien.
  1. ; $p7 := Vital Name (vitals only)
  1. ; $p8 := manual data entry supported
  1. ; $p9 := Block ien
  1. ; $p10 := block row
  1. ; $p11 := block column
  1. ;
  1. N C,BLK,SEL,X,Y,ROW,COL,RESULT1,VITAL,CNT,ARRY,SEL1
  1. I $E($G(RESULT),1)="^" S ARRY=RESULT
  1. E S ARRY="RESULT"
  1. ;
  1. I +FRM'=FRM,FRM'="" S FRM=+$O(^IBE(357,"B",FRM,0))
  1. I 'FRM S FRM=$$DEFAULT S:FRM @ARRY@(0)="Using default form" G:'FRM FRMLSTQ
  1. I $G(FTYP)="" S FTYP=1
  1. I $G(KILL)="" S KILL=1 K:KILL @ARRY
  1. I $G(@ARRY@(0))="" S @ARRY@(0)="Form Not Found"
  1. I '$G(ALLOBJ),$P($G(^IBE(357,FRM,0)),"^",12)'=1 S @ARRY@(0)="Form not scannable" G FRMLSTQ
  1. ;
  1. ; -- first find all the blocks
  1. S X=0 F S X=$O(^IBE(357.1,"C",FRM,X)) Q:'X S BLK=X D
  1. .; -- get row and column of block
  1. .S ROW=$P($G(^IBE(357.1,+BLK,0)),"^",4),COL=$P(^(0),"^",5)
  1. .Q:ROW=""!(COL="")
  1. .;
  1. .; -- now find all the selection lists with input interfaces
  1. .S Y=0 F S Y=$O(^IBE(357.2,"C",BLK,Y)) Q:'Y D
  1. ..S SEL=+$P($G(^IBE(357.2,+Y,0)),"^",11)
  1. ..;I $P($G(^IBE(357.6,+SEL,0)),"^",13)'=""!($G(ALLOBJ)) D ; has input interface
  1. ..S SEL1=$P($G(^IBE(357.6,+SEL,0)),"^",13)
  1. ..I '$G(ALLOBJ) S SEL=SEL1
  1. ..I $G(ALLOBJ),SEL1'="" S SEL=SEL1
  1. ..Q:$G(^IBE(357.6,+SEL,0))=""
  1. ..D ADDIN(.RESULT1,FRM,FTYP,SEL,3,+Y,BLK,ROW,COL)
  1. ..Q
  1. .;
  1. .; -- find multiple choice fields
  1. .S Y=0 F S Y=$O(^IBE(357.93,"C",BLK,Y)) Q:'Y D
  1. ..S SEL=+$P($G(^IBE(357.93,+Y,0)),"^",6)
  1. ..I $P($G(^IBE(357.6,+SEL,0)),"^",13)'="" D
  1. ...S SEL=$P($G(^IBE(357.6,+SEL,0)),"^",13)
  1. ...Q:$G(^IBE(357.6,+SEL,0))=""
  1. ...D ADDIN(.RESULT1,FRM,FTYP,SEL,4,Y,BLK,ROW,COL)
  1. ..I $P($G(^IBE(357.6,+SEL,0)),"^",6)=1 D ADDIN(.RESULT1,FRM,FTYP,SEL,4,Y,BLK,ROW,COL)
  1. ..Q
  1. .;
  1. .; -- find Hand Print fields
  1. .S Y=0 F S Y=$O(^IBE(359.94,"C",BLK,Y)) Q:'Y D
  1. ..S SEL=+$P($G(^IBE(359.94,+Y,0)),"^",6)
  1. ..S VITAL=""
  1. ..I $P($G(^IBE(357.6,+SEL,0)),"^")["VITAL" S VITAL=$P($G(^IBE(359.1,+$P($G(^IBE(359.94,+Y,0)),"^",10),0)),"^")
  1. ..I $P($G(^IBE(357.6,+SEL,0)),"^",13)'="" D
  1. ...S SEL=$P($G(^IBE(357.6,+SEL,0)),"^",13)
  1. ...Q:$G(^IBE(357.6,+SEL,0))=""
  1. ...D ADDIN(.RESULT1,FRM,FTYP,SEL,5,Y,BLK,ROW,COL)
  1. ..I $P($G(^IBE(357.6,+SEL,0)),"^",6)=1 D ADDIN(.RESULT1,FRM,FTYP,SEL,5,Y,BLK,ROW,COL,VITAL)
  1. ..Q
  1. .;
  1. .I $G(ALLOBJ) D
  1. ..; find Data fields
  1. ..S Y=0 F S Y=$O(^IBE(357.5,"C",BLK,Y)) Q:'Y D ADDIN(.RESULT1,FRM,FTYP,+$P($G(^IBE(357.5,+Y,0)),"^",3),6,Y,BLK,ROW,COL)
  1. ..
  1. ..; find form lines
  1. ..S Y=0 F S Y=$O(^IBE(357.7,"C",BLK,Y)) Q:'Y D ADDIN(.RESULT1,FRM,FTYP,"FORM LINE",7,Y,BLK,ROW,COL)
  1. ..;
  1. ..; find text areas
  1. ..S Y=0 F S Y=$O(^IBE(357.8,"C",BLK,Y)) Q:'Y D ADDIN(.RESULT1,FRM,FTYP,"TEXT AREA",8,Y,BLK,ROW,COL)
  1. .Q
  1. ;
  1. ; -- now set results into single array
  1. S ROW="",CNT=+$G(@ARRY@(0))
  1. F S ROW=$O(RESULT1(ROW)) Q:ROW="" S COL="" F S COL=$O(RESULT1(ROW,COL)) Q:COL="" D
  1. .S C=0 F S C=$O(RESULT1(ROW,COL,C)) Q:C="" D
  1. ..S CNT=CNT+1
  1. ..S @ARRY@(CNT)=RESULT1(ROW,COL,C)
  1. S @ARRY@(0)=CNT
  1. K RESULT1
  1. ;
  1. FRMLSTQ Q
  1. ;
  1. ADDIN(RESULT1,FRM,FTYP,SEL,ITYP,ENTRY,BLK,ROW,COL,VITAL) ; --add to array
  1. N ITYPE1
  1. S ITYPE1=$S(ITYP=3:"LIST",ITYP=4:"MC",ITYP=5:"HP",ITYP=6:"DF",ITYP=7:"FL",ITYP=8:"TA",1:"OTHER")
  1. S RESULT1(0)=$G(RESULT1(0))+1
  1. S RESULT1(+ROW,+COL,RESULT1(0))=$S(+SEL:$P($G(^IBE(357.6,+SEL,0)),"^"),1:SEL)_"^"_SEL_"^"_$P($G(^IBE(357,+FRM,0)),"^")_"^"_$P($T(TYP+FTYP),";;",2)_"^"_ITYPE1_"^"_$G(ENTRY)_"^"_$G(VITAL)_"^"_$$MNL
  1. S RESULT1(+ROW,+COL,RESULT1(0))=RESULT1(+ROW,+COL,RESULT1(0))_"^"_$G(BLK)_"^"_$G(ROW)_"^"_$G(COL)
  1. Q
  1. ;
  1. MNL() ; -- is manual data entry supported
  1. Q $S($G(^IBE(357.6,+SEL,18))'="":1,1:0)
  1. ;
  1. DEFAULT() ; -- find default form from parameters
  1. N FRM
  1. S FRM=$P($G(^IBD(357.09,1,0)),"^",4)
  1. I FRM="" S FRM=$O(^IBE(357,"B","PRIMARY CARE SAMPLE V2.1",0))
  1. Q FRM
  1. ;
  1. TESTC ; -- test list by clinic
  1. K TEST
  1. D CLNLSTI(.TEST,25)
  1. X "ZW TEST"
  1. Q
  1. ;
  1. TESTF ; -- test list by form
  1. K TEST
  1. D FRMLSTI(.TEST,91)
  1. X "ZW TEST"
  1. Q
  1. ;
  1. TYP ; types of forms/from piece in 409.95
  1. ;;
  1. ;;BASIC FORM
  1. ;;SUPPLIMENTAL FORM, EST. PATIENTS
  1. ;;SUPPLEMENTAL FORM, FIRST VISIT
  1. ;;FORM W/O PATIENT DATA
  1. ;;SUPPLEMENTAL FORM
  1. ;;
  1. ;;SUPPLEMENTAL FORM
  1. ;;SUPPLEMENTAL FORM
  1. ;;
  1. ;;DEFAULT FORM
  1. ;;