LA7XREF ;DALOI/JDB - LA7 FILE UTILITIES ;03/07/12 16:11
;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
;
Q
;
ITP02 ;
; Input Transform for #62.4701 Field .02
N LAT
S LAT=$T
K:$L(X)>15!($L(X)<1)!'(X?.(1"LN",1"SCT",1"L",1"99"1.UN.1"."1.UN)) X
I $G(X)'="" I '$G(LRFPRIV) K:$P($G(^(0)),"^",5)="0"&(X'?.(1"L"0E,1"99"1.UN.1"."1.UN)) X
I $G(X)'="" D CODSETOK^LA7VLCM3(DA(1),DA,,X,1)
I LAT ;reset $T
Q
;
OT62482(LAY) ;
; Output Transform routine for #62.48 subfile #62.482 field .01
; Appends file info to the entry for display purposes.
; Inputs
; LAY : The variable pointer reference ie 1;LAB(61,
; Output
; : .01's value and the file info ie BLOOD [SP #61:1]
N STR,LAX,LAIEN,QUIET,INFO,OUT,X,Y
S QUIET=0
S (OUT,LAY)=$G(LAY)
S STR=$$VARPTR01(LAY,.INFO)
I STR'="" S OUT=STR
S QUIET=$$ISQUIET^LRXREF()
I 'QUIET S QUIET=$D(DDS)
I 'QUIET D ;
. S LAIEN=INFO("IEN")
. S LAX=INFO("FN")
. I LAX'="" D ;
. . S STR=$S(+LAX=61:"SP",+LAX=62:"CS",1:"")
. . I STR'="" S STR="["_STR_" #"_+LAX_":"_LAIEN_"]"
. . S OUT=OUT_" "_STR
. ;
Q OUT
;
ID62482() ;
; Handles the WRITE IDENTIFIER logic in DD for File #62.48
; subfile #62.482 field #.02
; Available variables: Y=IEN, Naked global reference of record
N STR,X,Y,IEN
S STR=""
S X=$G(^(0)) ; from FM call -- the 0 node of the 62.482 record
S X=$P(X,U,1)
S IEN=$P(X,";",1)
S X=$P(X,";",2) ;file ID
S X=$P(X,"(",2) ; file number
I X'="" D ;
. S STR=$S(+X=61:"SP",+X=62:"CS",1:"")
. I STR'="" S STR="["_STR_" #"_+X_":"_IEN_"]"
Q STR
;
VARPTR01(LAY,INFO) ;
;
; LAY ; The internal var pointer representation ie: 1;LAB(61,
; INFO <byref> <opt> <output>
;
; DDS = FM var when used with DBS calls
; DIQUIET
N LAREC,LAFN,LAMSG,LAVAL,LAX,DA,X,Y,DIERR
S LAVAL=LAY
S LAREC=+$P(LAY,";",1)
S LAFN=$P(LAY,";",2)
S LAFN=$P(LAFN,"(",2)
S LAFN=$P(LAFN,",",1)
D ;
. S LAX=$$GET1^DIQ(LAFN,LAREC_",",.01,"","","LAMSG")
. I LAX'="" S LAVAL=LAX
S INFO("FN")=LAFN
S INFO("IEN")=LAREC
Q LAVAL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7XREF 2075 printed Dec 13, 2024@01:41:12 Page 2
LA7XREF ;DALOI/JDB - LA7 FILE UTILITIES ;03/07/12 16:11
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**74**;Sep 27, 1994;Build 229
+2 ;
+3 QUIT
+4 ;
ITP02 ;
+1 ; Input Transform for #62.4701 Field .02
+2 NEW LAT
+3 SET LAT=$TEST
+4 if $LENGTH(X)>15!($LENGTH(X)<1)!'(X?.(1"LN",1"SCT",1"L",1"99"1.UN.1"."1.UN))
KILL X
+5 IF $GET(X)'=""
IF '$GET(LRFPRIV)
if $PIECE($GET(^(0)),"^",5)="0"&(X'?.(1"L"0E,1"99"1.UN.1"."1.UN))
KILL X
+6 IF $GET(X)'=""
DO CODSETOK^LA7VLCM3(DA(1),DA,,X,1)
+7 ;reset $T
IF LAT
+8 QUIT
+9 ;
OT62482(LAY) ;
+1 ; Output Transform routine for #62.48 subfile #62.482 field .01
+2 ; Appends file info to the entry for display purposes.
+3 ; Inputs
+4 ; LAY : The variable pointer reference ie 1;LAB(61,
+5 ; Output
+6 ; : .01's value and the file info ie BLOOD [SP #61:1]
+7 NEW STR,LAX,LAIEN,QUIET,INFO,OUT,X,Y
+8 SET QUIET=0
+9 SET (OUT,LAY)=$GET(LAY)
+10 SET STR=$$VARPTR01(LAY,.INFO)
+11 IF STR'=""
SET OUT=STR
+12 SET QUIET=$$ISQUIET^LRXREF()
+13 IF 'QUIET
SET QUIET=$DATA(DDS)
+14 ;
IF 'QUIET
Begin DoDot:1
+15 SET LAIEN=INFO("IEN")
+16 SET LAX=INFO("FN")
+17 ;
IF LAX'=""
Begin DoDot:2
+18 SET STR=$SELECT(+LAX=61:"SP",+LAX=62:"CS",1:"")
+19 IF STR'=""
SET STR="["_STR_" #"_+LAX_":"_LAIEN_"]"
+20 SET OUT=OUT_" "_STR
End DoDot:2
+21 ;
End DoDot:1
+22 QUIT OUT
+23 ;
ID62482() ;
+1 ; Handles the WRITE IDENTIFIER logic in DD for File #62.48
+2 ; subfile #62.482 field #.02
+3 ; Available variables: Y=IEN, Naked global reference of record
+4 NEW STR,X,Y,IEN
+5 SET STR=""
+6 ; from FM call -- the 0 node of the 62.482 record
SET X=$GET(^(0))
+7 SET X=$PIECE(X,U,1)
+8 SET IEN=$PIECE(X,";",1)
+9 ;file ID
SET X=$PIECE(X,";",2)
+10 ; file number
SET X=$PIECE(X,"(",2)
+11 ;
IF X'=""
Begin DoDot:1
+12 SET STR=$SELECT(+X=61:"SP",+X=62:"CS",1:"")
+13 IF STR'=""
SET STR="["_STR_" #"_+X_":"_IEN_"]"
End DoDot:1
+14 QUIT STR
+15 ;
VARPTR01(LAY,INFO) ;
+1 ;
+2 ; LAY ; The internal var pointer representation ie: 1;LAB(61,
+3 ; INFO <byref> <opt> <output>
+4 ;
+5 ; DDS = FM var when used with DBS calls
+6 ; DIQUIET
+7 NEW LAREC,LAFN,LAMSG,LAVAL,LAX,DA,X,Y,DIERR
+8 SET LAVAL=LAY
+9 SET LAREC=+$PIECE(LAY,";",1)
+10 SET LAFN=$PIECE(LAY,";",2)
+11 SET LAFN=$PIECE(LAFN,"(",2)
+12 SET LAFN=$PIECE(LAFN,",",1)
+13 ;
Begin DoDot:1
+14 SET LAX=$$GET1^DIQ(LAFN,LAREC_",",.01,"","","LAMSG")
+15 IF LAX'=""
SET LAVAL=LAX
End DoDot:1
+16 SET INFO("FN")=LAFN
+17 SET INFO("IEN")=LAREC
+18 QUIT LAVAL
