RAFLH2 ;HISC/GJC-Utility determines if flash cards print. ; 01 Jun 2012 10:58 AM
;;5.0;Radiology/Nuclear Medicine;**47,1004**;Mar 16, 1998;Build 21
;
;This patch was modified by Stuart Frank in May 2012
;
;Integration Agreements
;----------------------
;$$NS^XUAF4(2171); $$KSP^XUPARAM(2541)
;
PRINT(RADIV,RALOC,RAPRC) ;
; Pass in 'RAMDIV', 'RAMLC' & proc. array i.e, 'RAPX'.
; Pass back '0' if the print is to be aborted, '>0' to print.
N I,RA71,RA79,RA791,RAFLG,X,X1
S RA79(.1)=$G(^RA(79,RADIV,.1)),RA791(0)=$G(^RA(79.1,+RALOC,0))
S RA79(.12)=$S($P(RA79(.1),"^",2)']"":0,"Nn"[$P(RA79(.1),"^",2):0,1:1)
S RA79(.18)=$S($P(RA79(.1),"^",8)']"":0,"Nn"[$P(RA79(.1),"^",8):0,1:1)
S RA791(2)=$S('+$P(RA791(0),"^",2):0,1:1) ; '0' if null or zero
S RA791(4)=$S('+$P(RA791(0),"^",4):0,1:1) ; '0' if null or zero
S RA791(8)=$S('+$P(RA791(0),"^",8):0,1:1) ; '0' if null or zero
; 'RAPRC' in format of: Case #_^_$G(^RAMIS(71,proc,0))
; where 'proc' is the procedure IEN. created in [RA REGISTER]
S I=0 F S I=$O(RAPRC(I)) Q:I'>0 D
. S X=$G(RAPRC(I)),X1=$P(X,"^",5)
. S RA71=+$G(RA71)+($S(X1']"":0,1:1))
. Q
S RAFLG=+$G(RA71)+RA791(2)+RA791(4)+RA791(8)+RA79(.12)+RA79(.18)
Q RAFLG
KILFLH(X) ; Kill Flash Card Formats variables.
; X -> IEN of file of the Label Print Fields file.
; Called from 6^RAMAIN & Q^RAFLH1
Q:$G(^RA(78.7,X,0))']"" S RA787(0)=$G(^RA(78.7,X,0))
K @$P(RA787(0),"^",5),RA787(0)
Q
SETFLH(Y) ; Set Flash Card Formats variables.
; Y -> IEN of file of the Label Print Fields file.
; Called from 6^RAMAIN & START^RAFLH1
Q:$G(^RA(78.7,Y,0))']"" S RA787(0)=$G(^RA(78.7,Y,0))
I $P(RA787(0),U)="LONG CASE NUMBER" D LONGCASE(RA787(0)) Q
S @$P(RA787(0),"^",5)=$P(RA787(0),"^",4)
Q
XECFLH(X,Y) ; Execute the "E" node for the Flash Card Formats file (78.2).
; X -> IEN of the top level ; Y -> IEN at the first subfile level.
; Called from RAFLH & RAFLH1
N I S I=0
F S I=$O(RAIND1(I)) Q:'+I S ^TMP($J,"RA FLASH",I)=RAIND1(I)
I '$D(RATEST) X ^RA(78.2,X,"E",Y,0) Q
N RASAV,RATMP S RASAV=$G(^RA(78.2,X,"E",Y,0))
S RATMP=$P(RASAV,"@")_$P(RASAV,"@",2) X RATMP
S ^RA(78.2,X,"E",Y,0)=RASAV
Q
;
LONGCASE(X) ;Set the INTERNAL VARIABLE (78.7 field 5) to the TEST VALUE (78.7 field 4)
;when the LABEL PRINT FIELD record is: LONG CASE NUMBER (p47)
;
;Input: X-zero node of a file 78.7 record
;
;"081194-234" is generic; it is not a direct reference to any specific patient exam.
;
N RAI S RAI=$$USESSAN^RAHLRU1() ;if RAI use LONG CASE NUMBER w/site prefix
S @$P(X,U,5)=$S(RAI:$P($$SITE^VASITE(),"^",3)_"-",1:"")_"081194-234" ;SAF - get station number but don't truncate at 3 characters in IHS
;S @$P(X,U,5)=$S(RAI:$E($P($$NS^XUAF4($$KSP^XUPARAM("INST")),U,2),1,3)_"-",1:"")_"081194-234"
Q
;
RAFLH2 ;HISC/GJC-Utility determines if flash cards print. ; 01 Jun 2012 10:58 AM
+1 ;;5.0;Radiology/Nuclear Medicine;**47,1004**;Mar 16, 1998;Build 21
+2 ;
+3 ;This patch was modified by Stuart Frank in May 2012
+4 ;
+5 ;Integration Agreements
+6 ;----------------------
+7 ;$$NS^XUAF4(2171); $$KSP^XUPARAM(2541)
+8 ;
PRINT(RADIV,RALOC,RAPRC) ;
+1 ; Pass in 'RAMDIV', 'RAMLC' & proc. array i.e, 'RAPX'.
+2 ; Pass back '0' if the print is to be aborted, '>0' to print.
+3 NEW I,RA71,RA79,RA791,RAFLG,X,X1
+4 SET RA79(.1)=$GET(^RA(79,RADIV,.1))
SET RA791(0)=$GET(^RA(79.1,+RALOC,0))
+5 SET RA79(.12)=$SELECT($PIECE(RA79(.1),"^",2)']"":0,"Nn"[$PIECE(RA79(.1),"^",2):0,1:1)
+6 SET RA79(.18)=$SELECT($PIECE(RA79(.1),"^",8)']"":0,"Nn"[$PIECE(RA79(.1),"^",8):0,1:1)
+7 ; '0' if null or zero
SET RA791(2)=$SELECT('+$PIECE(RA791(0),"^",2):0,1:1)
+8 ; '0' if null or zero
SET RA791(4)=$SELECT('+$PIECE(RA791(0),"^",4):0,1:1)
+9 ; '0' if null or zero
SET RA791(8)=$SELECT('+$PIECE(RA791(0),"^",8):0,1:1)
+10 ; 'RAPRC' in format of: Case #_^_$G(^RAMIS(71,proc,0))
+11 ; where 'proc' is the procedure IEN. created in [RA REGISTER]
+12 SET I=0
FOR
SET I=$ORDER(RAPRC(I))
IF I'>0
QUIT
Begin DoDot:1
+13 SET X=$GET(RAPRC(I))
SET X1=$PIECE(X,"^",5)
+14 SET RA71=+$GET(RA71)+($SELECT(X1']"":0,1:1))
+15 QUIT
End DoDot:1
+16 SET RAFLG=+$GET(RA71)+RA791(2)+RA791(4)+RA791(8)+RA79(.12)+RA79(.18)
+17 QUIT RAFLG
KILFLH(X) ; Kill Flash Card Formats variables.
+1 ; X -> IEN of file of the Label Print Fields file.
+2 ; Called from 6^RAMAIN & Q^RAFLH1
+3 IF $GET(^RA(78.7,X,0))']""
QUIT
SET RA787(0)=$GET(^RA(78.7,X,0))
+4 KILL @$PIECE(RA787(0),"^",5),RA787(0)
+5 QUIT
SETFLH(Y) ; Set Flash Card Formats variables.
+1 ; Y -> IEN of file of the Label Print Fields file.
+2 ; Called from 6^RAMAIN & START^RAFLH1
+3 IF $GET(^RA(78.7,Y,0))']""
QUIT
SET RA787(0)=$GET(^RA(78.7,Y,0))
+4 IF $PIECE(RA787(0),U)="LONG CASE NUMBER"
DO LONGCASE(RA787(0))
QUIT
+5 SET @$PIECE(RA787(0),"^",5)=$PIECE(RA787(0),"^",4)
+6 QUIT
XECFLH(X,Y) ; Execute the "E" node for the Flash Card Formats file (78.2).
+1 ; X -> IEN of the top level ; Y -> IEN at the first subfile level.
+2 ; Called from RAFLH & RAFLH1
+3 NEW I
SET I=0
+4 FOR
SET I=$ORDER(RAIND1(I))
IF '+I
QUIT
SET ^TMP($JOB,"RA FLASH",I)=RAIND1(I)
+5 IF '$DATA(RATEST)
XECUTE ^RA(78.2,X,"E",Y,0)
QUIT
+6 NEW RASAV,RATMP
SET RASAV=$GET(^RA(78.2,X,"E",Y,0))
+7 SET RATMP=$PIECE(RASAV,"@")_$PIECE(RASAV,"@",2)
XECUTE RATMP
+8 SET ^RA(78.2,X,"E",Y,0)=RASAV
+9 QUIT
+10 ;
LONGCASE(X) ;Set the INTERNAL VARIABLE (78.7 field 5) to the TEST VALUE (78.7 field 4)
+1 ;when the LABEL PRINT FIELD record is: LONG CASE NUMBER (p47)
+2 ;
+3 ;Input: X-zero node of a file 78.7 record
+4 ;
+5 ;"081194-234" is generic; it is not a direct reference to any specific patient exam.
+6 ;
+7 ;if RAI use LONG CASE NUMBER w/site prefix
NEW RAI
SET RAI=$$USESSAN^RAHLRU1()
+8 ;SAF - get station number but don't truncate at 3 characters in IHS
SET @$PIECE(X,U,5)=$SELECT(RAI:$PIECE($$SITE^VASITE(),"^",3)_"-",1:"")_"081194-234"
+9 ;S @$P(X,U,5)=$S(RAI:$E($P($$NS^XUAF4($$KSP^XUPARAM("INST")),U,2),1,3)_"-",1:"")_"081194-234"
+10 QUIT
+11 ;
