- RAFLH2 ;HISC/GJC-Utility determines if flash cards print. ;4/3/97 07:57
- ;;5.0;Radiology/Nuclear Medicine;**47**;Mar 16, 1998;Build 21
- ;
- ;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:$E($P($$NS^XUAF4($$KSP^XUPARAM("INST")),U,2),1,3)_"-",1:"")_"081194-234"
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAFLH2 2586 printed Feb 19, 2025@00:01:25 Page 2
- RAFLH2 ;HISC/GJC-Utility determines if flash cards print. ;4/3/97 07:57
- +1 ;;5.0;Radiology/Nuclear Medicine;**47**;Mar 16, 1998;Build 21
- +2 ;
- +3 ;Integration Agreements
- +4 ;----------------------
- +5 ;$$NS^XUAF4(2171); $$KSP^XUPARAM(2541)
- +6 ;
- 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 SET @$PIECE(X,U,5)=$SELECT(RAI:$EXTRACT($PIECE($$NS^XUAF4($$KSP^XUPARAM("INST")),U,2),1,3)_"-",1:"")_"081194-234"
- +9 QUIT
- +10 ;