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.  ;;