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

BEHORXFM.m

Go to the documentation of this file. 
  1. BEHORXFM ;IHS/MSC/PLS - Med Component print layout support;20-Dec-2012 12:54;DU
  1.  ;;1.1;BEH COMPONENTS;**009007**;Mar 20, 2007;Build 1
  1.  ;=================================================================
  1.  ; Return list of templates
  1. GETLIST(DATA,TYPE) ;EP-
  1.  N CNT,IEN
  1.  S TYPE=$G(TYPE)
  1.  S DATA=$$TMPGBL()
  1.  S (CNT,IEN)=0
  1.  F  S IEN=$O(^BEHORX(90460.07,IEN)) Q:'IEN  D
  1.  .Q:TYPE'=""&($P(^BEHORX(90460.07,IEN,0),U,2)'=TYPE)
  1.  .S CNT=CNT+1,@DATA@(CNT)=^(0)
  1.  Q
  1.  ; Return template data
  1. GETTEMPL(DATA,TMPL) ;
  1.  ;TODO - Add flag and check for active status
  1.  S DATA=$$TMPGBL
  1.  S:TMPL'=+TMPL TMPL=$$TMPL(TMPL)
  1.  M:TMPL @DATA=^BEHORX(90460.07,TMPL,1)
  1.  K @DATA@(0)
  1.  Q
  1.  ; Set template data
  1.  ; TMPL- Name of template
  1.  ;  CNT- Line count of template data
  1.  ;   IN- Input array of field data
  1.  ;       Examples: IN(.02)="PC"
  1.  ;  VAL- (1,0) array of template data
  1.  ;
  1. SETTEMPL(DATA,TMPL,CNT,IN,VAL) ;
  1.  N X,Y,Z
  1.  S DATA=$$TMPL(.TMPL,.Z)
  1.  I 'DATA,CNT D
  1.  .L +^BEHORX(90460.07,0):5
  1.  .E  Q
  1.  .S DATA=$O(^BEHORX(90460.07,$C(1)),-1)+1,$P(^(0),U,3,4)=DATA_U_($P(^(0),U,4)+1),^(DATA,0)=TMPL,^BEHORX(90460.07,"B",Z,DATA)=""
  1.  .L -^BEHORX(90460.07,0)
  1.  Q:'DATA
  1.  L +^BEHORX(90460.07,DATA):5
  1.  E  S DATA=0 Q
  1.  I 'CNT D
  1.  .D TMPLDEL(TMPL)
  1.  E  D
  1.  .D WP^DIE(90460.07,DATA_",",1,,"VAL")
  1.  .S:$L($G(IN(.02))) $P(^BEHORX(90460.07,+DATA,0),U,2)=IN(.02)
  1.  .S:$L($G(IN(.03))) $P(^BEHORX(90460.07,+DATA,0),U,3)=$P(IN(.03),".")
  1.  L -^BEHORX(90460.07,DATA)
  1.  Q
  1.  ; Mark a template inactive and remove all associations
  1. TMPLDEL(TMPL) ;
  1.  N ENT
  1.  D TMPLPAR(.ENT,.TMPL)
  1.  S ENT=""
  1.  F  S ENT=$O(ENT(ENT)) Q:'$L(ENT)  D
  1.  .D DEL^XPAR(ENT,"BEHORX PRINT FORMATS",$P(^BEHORX(90460.07,TMPL,0),U,2))
  1.  S $P(^BEHORX(90460.07,TMPL,0),U,4)=DT
  1.  Q
  1.  ; Get parameters associated with a template
  1.  ; Return format is DATA(<entity>,1)=<template IEN>
  1. TMPLPAR(DATA,TMPL) ;
  1.  N X,INT
  1.  K DATA
  1.  S:TMPL'=+TMPL TMPL=$$TMPL(TMPL)
  1.  Q:'TMPL
  1.  S INT=$P(^BEHORX(90460.07,TMPL,0),U,2)
  1.  D ENVAL^XPAR(.DATA,"BEHORX PRINT FORMATS",INT)
  1.  S X=""
  1.  F  S X=$O(DATA(X)) Q:'$L(X)  D:$G(DATA(X,INT))'=TMPL
  1.  .K DATA(X)
  1.  .S DATA=DATA-1
  1.  Q
  1.  ; Convert template name to IEN
  1. TMPL(X,Y) ;
  1.  Q $$GETIEN(90460.07,.X,.Y)
  1.  ; Convert IEN to .01 value
  1. GETNAM(FNUM,IEN) ;
  1.  Q $P($G(@$$ROOT^DILFD(FNUM,,1)@(IEN,0)),U)
  1.  ; Convert .01 value to IEN
  1. GETIEN(FNUM,VAL,TRC) ;
  1.  N RTN,GBL,PASS
  1.  S GBL=$$ROOT^DILFD(FNUM,,1),RTN=0
  1.  I $L(GBL),$L(VAL),VAL'=+VAL D
  1.  .F PASS=0,1 D  Q:RTN
  1.  ..S:PASS VAL=$$UP^XLFSTR(VAL)
  1.  ..S TRC=$E(VAL,1,50)
  1.  ..F  S RTN=+$O(@GBL@("B",TRC,RTN)) Q:'RTN  Q:$P($G(@GBL@(RTN,0)),U)=VAL
  1.  Q RTN
  1.  ; Return temp global reference
  1. TMPGBL() N GBL
  1.  S GBL=$NA(^TMP("BEHORXFM",$J))
  1.  K @GBL
  1.  Q GBL
  1.  ; Return selectable instance types
  1. INSTTYP() ;
  1.  Q "PC:RX CII;PN:RX NON;PF:RX C35;OC:ORDER CII;ON:ORDER NON;OF:ORDER C35;RC:RECEIPT CII;RN:RECEIPT NON-CII;LC:LABEL CII;LN:LABEL NON-CII"
  1.  ; Screen logic for value field of BEHORX PRINT FORMATS parameter
  1. SCRNPF(INST) ;EP-
  1.  Q $P(^(0),U,2)=INST&('$P(^(0),U,4))&($P(^(0),U,3))&($P(^(0),U,3)'>DT)
  1.  ;