BEHORXFM ;IHS/MSC/PLS - Med Component print layout support;20-Dec-2012 12:54;DU
;;1.1;BEH COMPONENTS;**009007**;Mar 20, 2007;Build 1
;=================================================================
; Return list of templates
GETLIST(DATA,TYPE) ;EP-
N CNT,IEN
S TYPE=$G(TYPE)
S DATA=$$TMPGBL()
S (CNT,IEN)=0
F S IEN=$O(^BEHORX(90460.07,IEN)) Q:'IEN D
.Q:TYPE'=""&($P(^BEHORX(90460.07,IEN,0),U,2)'=TYPE)
.S CNT=CNT+1,@DATA@(CNT)=^(0)
Q
; Return template data
GETTEMPL(DATA,TMPL) ;
;TODO - Add flag and check for active status
S DATA=$$TMPGBL
S:TMPL'=+TMPL TMPL=$$TMPL(TMPL)
M:TMPL @DATA=^BEHORX(90460.07,TMPL,1)
K @DATA@(0)
Q
; Set template data
; TMPL- Name of template
; CNT- Line count of template data
; IN- Input array of field data
; Examples: IN(.02)="PC"
; VAL- (1,0) array of template data
;
SETTEMPL(DATA,TMPL,CNT,IN,VAL) ;
N X,Y,Z
S DATA=$$TMPL(.TMPL,.Z)
I 'DATA,CNT D
.L +^BEHORX(90460.07,0):5
.E Q
.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)=""
.L -^BEHORX(90460.07,0)
Q:'DATA
L +^BEHORX(90460.07,DATA):5
E S DATA=0 Q
I 'CNT D
.D TMPLDEL(TMPL)
E D
.D WP^DIE(90460.07,DATA_",",1,,"VAL")
.S:$L($G(IN(.02))) $P(^BEHORX(90460.07,+DATA,0),U,2)=IN(.02)
.S:$L($G(IN(.03))) $P(^BEHORX(90460.07,+DATA,0),U,3)=$P(IN(.03),".")
L -^BEHORX(90460.07,DATA)
Q
; Mark a template inactive and remove all associations
TMPLDEL(TMPL) ;
N ENT
D TMPLPAR(.ENT,.TMPL)
S ENT=""
F S ENT=$O(ENT(ENT)) Q:'$L(ENT) D
.D DEL^XPAR(ENT,"BEHORX PRINT FORMATS",$P(^BEHORX(90460.07,TMPL,0),U,2))
S $P(^BEHORX(90460.07,TMPL,0),U,4)=DT
Q
; Get parameters associated with a template
; Return format is DATA(<entity>,1)=<template IEN>
TMPLPAR(DATA,TMPL) ;
N X,INT
K DATA
S:TMPL'=+TMPL TMPL=$$TMPL(TMPL)
Q:'TMPL
S INT=$P(^BEHORX(90460.07,TMPL,0),U,2)
D ENVAL^XPAR(.DATA,"BEHORX PRINT FORMATS",INT)
S X=""
F S X=$O(DATA(X)) Q:'$L(X) D:$G(DATA(X,INT))'=TMPL
.K DATA(X)
.S DATA=DATA-1
Q
; Convert template name to IEN
TMPL(X,Y) ;
Q $$GETIEN(90460.07,.X,.Y)
; Convert IEN to .01 value
GETNAM(FNUM,IEN) ;
Q $P($G(@$$ROOT^DILFD(FNUM,,1)@(IEN,0)),U)
; Convert .01 value to IEN
GETIEN(FNUM,VAL,TRC) ;
N RTN,GBL,PASS
S GBL=$$ROOT^DILFD(FNUM,,1),RTN=0
I $L(GBL),$L(VAL),VAL'=+VAL D
.F PASS=0,1 D Q:RTN
..S:PASS VAL=$$UP^XLFSTR(VAL)
..S TRC=$E(VAL,1,50)
..F S RTN=+$O(@GBL@("B",TRC,RTN)) Q:'RTN Q:$P($G(@GBL@(RTN,0)),U)=VAL
Q RTN
; Return temp global reference
TMPGBL() N GBL
S GBL=$NA(^TMP("BEHORXFM",$J))
K @GBL
Q GBL
; Return selectable instance types
INSTTYP() ;
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"
; Screen logic for value field of BEHORX PRINT FORMATS parameter
SCRNPF(INST) ;EP-
Q $P(^(0),U,2)=INST&('$P(^(0),U,4))&($P(^(0),U,3))&($P(^(0),U,3)'>DT)
;
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
+2 ;=================================================================
+3 ; Return list of templates
GETLIST(DATA,TYPE) ;EP-
+1 NEW CNT,IEN
+2 SET TYPE=$GET(TYPE)
+3 SET DATA=$$TMPGBL()
+4 SET (CNT,IEN)=0
+5 FOR
SET IEN=$ORDER(^BEHORX(90460.07,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+6 IF TYPE'=""&($PIECE(^BEHORX(90460.07,IEN,0),U,2)'=TYPE)
QUIT
+7 SET CNT=CNT+1
SET @DATA@(CNT)=^(0)
End DoDot:1
+8 QUIT
+9 ; Return template data
GETTEMPL(DATA,TMPL) ;
+1 ;TODO - Add flag and check for active status
+2 SET DATA=$$TMPGBL
+3 IF TMPL'=+TMPL
SET TMPL=$$TMPL(TMPL)
+4 IF TMPL
MERGE @DATA=^BEHORX(90460.07,TMPL,1)
+5 KILL @DATA@(0)
+6 QUIT
+7 ; Set template data
+8 ; TMPL- Name of template
+9 ; CNT- Line count of template data
+10 ; IN- Input array of field data
+11 ; Examples: IN(.02)="PC"
+12 ; VAL- (1,0) array of template data
+13 ;
SETTEMPL(DATA,TMPL,CNT,IN,VAL) ;
+1 NEW X,Y,Z
+2 SET DATA=$$TMPL(.TMPL,.Z)
+3 IF 'DATA
IF CNT
Begin DoDot:1
+4 LOCK +^BEHORX(90460.07,0):5
+5 IF '$TEST
QUIT
+6 SET DATA=$ORDER(^BEHORX(90460.07,$CHAR(1)),-1)+1
SET $PIECE(^(0),U,3,4)=DATA_U_($PIECE(^(0),U,4)+1)
SET ^(DATA,0)=TMPL
SET ^BEHORX(90460.07,"B",Z,DATA)=""
+7 LOCK -^BEHORX(90460.07,0)
End DoDot:1
+8 IF 'DATA
QUIT
+9 LOCK +^BEHORX(90460.07,DATA):5
+10 IF '$TEST
SET DATA=0
QUIT
+11 IF 'CNT
Begin DoDot:1
+12 DO TMPLDEL(TMPL)
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 DO WP^DIE(90460.07,DATA_",",1,,"VAL")
+15 IF $LENGTH($GET(IN(.02)))
SET $PIECE(^BEHORX(90460.07,+DATA,0),U,2)=IN(.02)
+16 IF $LENGTH($GET(IN(.03)))
SET $PIECE(^BEHORX(90460.07,+DATA,0),U,3)=$PIECE(IN(.03),".")
End DoDot:1
+17 LOCK -^BEHORX(90460.07,DATA)
+18 QUIT
+19 ; Mark a template inactive and remove all associations
TMPLDEL(TMPL) ;
+1 NEW ENT
+2 DO TMPLPAR(.ENT,.TMPL)
+3 SET ENT=""
+4 FOR
SET ENT=$ORDER(ENT(ENT))
IF '$LENGTH(ENT)
QUIT
Begin DoDot:1
+5 DO DEL^XPAR(ENT,"BEHORX PRINT FORMATS",$PIECE(^BEHORX(90460.07,TMPL,0),U,2))
End DoDot:1
+6 SET $PIECE(^BEHORX(90460.07,TMPL,0),U,4)=DT
+7 QUIT
+8 ; Get parameters associated with a template
+9 ; Return format is DATA(<entity>,1)=<template IEN>
TMPLPAR(DATA,TMPL) ;
+1 NEW X,INT
+2 KILL DATA
+3 IF TMPL'=+TMPL
SET TMPL=$$TMPL(TMPL)
+4 IF 'TMPL
QUIT
+5 SET INT=$PIECE(^BEHORX(90460.07,TMPL,0),U,2)
+6 DO ENVAL^XPAR(.DATA,"BEHORX PRINT FORMATS",INT)
+7 SET X=""
+8 FOR
SET X=$ORDER(DATA(X))
IF '$LENGTH(X)
QUIT
IF $GET(DATA(X,INT))'=TMPL
Begin DoDot:1
+9 KILL DATA(X)
+10 SET DATA=DATA-1
End DoDot:1
+11 QUIT
+12 ; Convert template name to IEN
TMPL(X,Y) ;
+1 QUIT $$GETIEN(90460.07,.X,.Y)
+2 ; Convert IEN to .01 value
GETNAM(FNUM,IEN) ;
+1 QUIT $PIECE($GET(@$$ROOT^DILFD(FNUM,,1)@(IEN,0)),U)
+2 ; Convert .01 value to IEN
GETIEN(FNUM,VAL,TRC) ;
+1 NEW RTN,GBL,PASS
+2 SET GBL=$$ROOT^DILFD(FNUM,,1)
SET RTN=0
+3 IF $LENGTH(GBL)
IF $LENGTH(VAL)
IF VAL'=+VAL
Begin DoDot:1
+4 FOR PASS=0,1
Begin DoDot:2
+5 IF PASS
SET VAL=$$UP^XLFSTR(VAL)
+6 SET TRC=$EXTRACT(VAL,1,50)
+7 FOR
SET RTN=+$ORDER(@GBL@("B",TRC,RTN))
IF 'RTN
QUIT
IF $PIECE($GET(@GBL@(RTN,0)),U)=VAL
QUIT
End DoDot:2
IF RTN
QUIT
End DoDot:1
+8 QUIT RTN
+9 ; Return temp global reference
TMPGBL() NEW GBL
+1 SET GBL=$NAME(^TMP("BEHORXFM",$JOB))
+2 KILL @GBL
+3 QUIT GBL
+4 ; Return selectable instance types
INSTTYP() ;
+1 QUIT "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"
+2 ; Screen logic for value field of BEHORX PRINT FORMATS parameter
SCRNPF(INST) ;EP-
+1 QUIT $PIECE(^(0),U,2)=INST&('$PIECE(^(0),U,4))&($PIECE(^(0),U,3))&($PIECE(^(0),U,3)'>DT)
+2 ;
