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

IBDFU1B.m

Go to the documentation of this file.
  1. IBDFU1B ;ALB/CJM - ENCOUNTER FORM ;11/16/92
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;**63**;APR 24, 1997;Build 80
  1. ;
  1. ;
  1. ;utilities
  1. BLKDESCR(IBBLK) ;parses the block record pointed to by IBBLK and puts the
  1. ;description in IBBLK array - should be called by reference
  1. ;returns 1 if block description is too incomplete to print block
  1. Q:'$G(IBBLK) 1
  1. N NODE0
  1. S NODE0=$G(^IBE(357.1,IBBLK,0))
  1. S IBBLK("NAME")=$P(NODE0,"^",1)
  1. S IBBLK("Y")=$P(NODE0,"^",4)
  1. S IBBLK("X")=$P(NODE0,"^",5)
  1. S IBBLK("W")=$P(NODE0,"^",6)
  1. S IBBLK("H")=$P(NODE0,"^",7)
  1. S IBBLK("BOX")=$P(NODE0,"^",10)
  1. S IBBLK("HDR")=$P(NODE0,"^",11)
  1. S IBBLK("HDISP")=$P(NODE0,"^",12)
  1. S IBBLK("S")=$P(NODE0,"^",3)
  1. S IBBLK("PAGE")=1+(IBBLK("Y")\IBFORM("PAGE_HT"))
  1. Q:NODE0="" 1
  1. Q 0
  1. ;
  1. RTNDSCR(RTN) ;RTN should be a pointer to the Package Interface file
  1. ;RTN should be passed by reference
  1. ;
  1. N NODE
  1. S NODE="",RTN=+$G(RTN)
  1. S:RTN NODE=$G(^IBE(357.6,RTN,0))
  1. S RTN("ACTION")=$P(NODE,"^",6)
  1. ;
  1. ;for input interfaces (mapping)
  1. I RTN("ACTION")=1 D Q
  1. .S RTN("AVAIL")=$P(NODE,"^",9)
  1. .Q
  1. ;
  1. ;for output interfaces
  1. I RTN("ACTION")=2 D Q
  1. .N NODFN
  1. .S NODFN=$P(NODE,"^",15)
  1. .S RTN("NAME")=$P(NODE,"^",1)
  1. .S RTN("RTN")=$P(NODE,"^",2,3)
  1. .S RTN("CHANGES")=$P(NODE,"^",5)
  1. .S RTN("DATATYPE")=$P(NODE,"^",7)
  1. .S RTN("FULL")=$P(NODE,"^",8)
  1. .S RTN("AVAIL")=$P(NODE,"^",9)
  1. .S RTN("ENTRY")=$S(RTN:$G(^IBE(357.6,RTN,4)),1:"")
  1. .S RTN("EXIT")=$S(RTN:$G(^IBE(357.6,RTN,5)),1:"")
  1. .;determine where the interface should put the data
  1. .I NODFN S RTN("DATA_LOCATION")="^TMP(""IB"",$J,""INTERFACES"","""_RTN("NAME")_""")"
  1. .I 'NODFN S RTN("DATA_LOCATION")="^TMP(""IB"",$J,""INTERFACES"",+$G(DFN),"""_RTN("NAME")_""")"
  1. ;
  1. ;for selection interfaces
  1. I RTN("ACTION")=3 D Q
  1. .S RTN("NAME")=$P(NODE,"^",1)
  1. .S RTN("RTN")=$P(NODE,"^",2,3)
  1. .S RTN("FULL")=$P(NODE,"^",8)
  1. .S RTN("AVAIL")=$P(NODE,"^",9)
  1. .S RTN("DYNAMIC")=$P(NODE,"^",14)
  1. .S RTN("ENTRY")=$S(RTN:$G(^IBE(357.6,RTN,4)),1:"")
  1. .S RTN("EXIT")=$S(RTN:$G(^IBE(357.6,RTN,5)),1:"")
  1. .S RTN("DATA_LOCATION")="^TMP(""IB"",$J,""INTERFACES"","""_RTN("NAME")_""")"
  1. .S RTN("NAME",1)=$$DATANAME(RTN,1),RTN("WIDTH",1)=$$DATANODE(RTN,1)
  1. .S RTN("INPUT_RTN")=$P(NODE,"^",13)
  1. ;
  1. ;for reports
  1. I RTN("ACTION")=4 D Q
  1. .S RTN("RTN")=$P(NODE,"^",2,3)
  1. .S RTN("AVAIL")=$P(NODE,"^",9)
  1. .S RTN("HSMRY?")=$P(NODE,"^",10)
  1. .S RTN("HSMRY")=$P(NODE,"^",11)
  1. .S RTN("ENTRY")=$S(RTN:$G(^IBE(357.6,RTN,4)),1:"")
  1. .S RTN("EXIT")=$S(RTN:$G(^IBE(357.6,RTN,5)),1:"")
  1. ;
  1. ;in case the action type is not defined
  1. S RTN("NAME")=$P(NODE,"^",1)
  1. S RTN("RTN")=$P(NODE,"^",2,3)
  1. S RTN("CHANGES")=$P(NODE,"^",5)
  1. S RTN("DATATYPE")=$P(NODE,"^",7)
  1. S RTN("FULL")=$P(NODE,"^",8)
  1. S RTN("AVAIL")=$P(NODE,"^",9)
  1. S RTN("DYNAMIC")=$P(NODE,"^",14)
  1. S RTN("ENTRY")=$S(RTN:$G(^IBE(357.6,RTN,4)),1:"")
  1. S RTN("EXIT")=$S(RTN:$G(^IBE(357.6,RTN,5)),1:"")
  1. ;
  1. ;I FULL,RTN S IEN=0 F S IEN=$O(^IBE(357.6,RTN,15,IEN)) Q:'IEN S NODE=$G(^IBE(357.6,RTN,15,IEN,0)) D
  1. ;.S I=$P(NODE,"^",3)
  1. ;.Q:'I
  1. ;.S RTN("NODE",I)=$P(NODE,"^",4),RTN("NAME",I)=$P(NODE,"^")
  1. Q
  1. ;
  1. WARNING(OBJECT) ; displays a warning
  1. S:'$D(OBJECT) OBJECT="object"
  1. W !,"WARNING! The "_OBJECT_" is partially outside the block."
  1. D PAUSE^IBDFU5
  1. Q
  1. ; ** The following routines assume BLKDESCR has been called and the IBBLK array is defined
  1. ;
  1. MINX() ;the smallest X a block element can begin at
  1. Q $S((IBBLK("BOX")=1):1,1:0)
  1. ;
  1. MAXX() ;the largest X a block element can begin at
  1. Q (IBBLK("W")-(1+$S(IBBLK("BOX")=1:1,1:0)))
  1. ;
  1. MINY() ;the smallest Y a block element can begin at
  1. Q $S(IBBLK("BOX")=1:1,1:0)
  1. ;
  1. MAXY() ;the largest Y a block element can begin at
  1. Q (IBBLK("H")-(1+$S((IBBLK("BOX")=1):1,1:0)))
  1. ;
  1. DORTN(IBRTN,IBDSERCH) ;calls the rtn specified by the pkg interface if ok
  1. ;IBRTN is an array containing data from the package interface in format returned by RTNDESCR and MUST be passed by reference
  1. ;returns 0 if not successful, 1 otherwise
  1. ;IBDSERCH: 1 = Wildcard search for ICD codes
  1. ; 2 = Lexicon search for ICD codes.
  1. ;Wildcard and Lexicon ICD searches done with the @IBRTN("RTN")
  1. N QUIT,VARIABLE,VARIEN,IBARY
  1. I '$D(IBDSERCH) S IBDSERCH=1 ;Set up Wildcard search as the default search.
  1. S QUIT=0
  1. ;
  1. ;set IBARY to node where the interface should return the data
  1. I (IBRTN("ACTION")=2)!(IBRTN("ACTION")=3) D
  1. .S IBARY=IBRTN("DATA_LOCATION")
  1. .K @IBARY
  1. ;
  1. Q:IBRTN("AVAIL")'=1 0
  1. ;
  1. ;verify that required variables exist
  1. S VARIEN=0 F S VARIEN=$O(^IBE(357.6,IBRTN,7,VARIEN)) Q:'VARIEN S VARIABLE=$P($G(^IBE(357.6,IBRTN,7,VARIEN,0)),"^") I '$D(@VARIABLE) S QUIT=1 Q
  1. Q:QUIT 0
  1. ;
  1. ;new protected variables
  1. S VARIEN=0 F S VARIEN=$O(^IBE(357.6,IBRTN,6,VARIEN)) Q:'VARIEN S VARIABLE=$P($G(^IBE(357.6,IBRTN,6,VARIEN,0)),"^") N @VARIABLE
  1. ;
  1. ;make sure the entry point is known
  1. Q:$G(IBRTN("RTN"))="" 0
  1. ;
  1. ;make sure the entry point exists
  1. Q:$P(IBRTN("RTN"),"^",2)="" 0
  1. I $P(IBRTN("RTN"),"^")'="" Q:'$L($T(@$P(IBRTN("RTN"),"^")^@$P($P(IBRTN("RTN"),"^",2),"("))) 0
  1. I $P(IBRTN("RTN"),"^")="" Q:'$L($T(^@$P($P(IBRTN("RTN"),"^",2),"("))) 0
  1. ;
  1. ;call the interface routine,xecute the entry and exit actions
  1. X IBRTN("ENTRY")
  1. D @IBRTN("RTN")
  1. X IBRTN("EXIT")
  1. Q 1
  1. ;
  1. DATANAME(RTN,PIECE) ;returns the name of the data for field=piece
  1. Q:'RTN!'PIECE ""
  1. I PIECE=1 Q $P($G(^IBE(357.6,RTN,2)),"^")
  1. N NODE,IEN
  1. S IEN=$O(^IBE(357.6,RTN,15,"C",PIECE,0))
  1. Q:'IEN ""
  1. Q $P($G(^IBE(357.6,RTN,15,IEN,0)),"^")
  1. ;
  1. DATANODE(RTN,PIECE) ;returns the node that the field=piece is on
  1. Q:'RTN!'PIECE ""
  1. I PIECE=1 Q ""
  1. S IEN=$O(^IBE(357.6,RTN,15,"C",PIECE,0))
  1. Q:'IEN ""
  1. Q $P($G(^IBE(357.6,RTN,15,IEN,0)),"^",4)
  1. ;
  1. DATATYPE(TYPE) ;returns the description of the datatype=TYPE
  1. ;TYPE must be passed by reference
  1. ;
  1. N NODE
  1. S NODE=""
  1. I $G(TYPE) S NODE=$G(^IBE(359.1,TYPE,0))
  1. S TYPE("SPACE")=$P(NODE,"^",6)
  1. S TYPE("MAX_INPUT")=$P(NODE,"^",2)
  1. S TYPE("FORMAT")=$P(NODE,"^",5)
  1. Q