MAGNAU03 ;WOIFO/NST - Utilities for RPC calls ; 29 Jun 2017 4:16 PM
;;3.0;IMAGING;**185**;Mar 19, 2002;Build 92;Aug 02, 2012
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
;
; **** Get a record from a file by IEN
;
; Input parameters
; ================
;
; FILE = FileMan number of the file (e.g. 2005.003)
; PK = IEN in the file
; FLAGS
; D - exclude deleted annotations
; U - include all user's annotations
; W - include word processing fields
; CNT = First node in output array
;
; Return Values
; =============
; if error found during execution
; MAGRY(0) = Failure status^Error getting values
; if success
; MAGRY(0) = Success status^^Total lines
; MAGRY(1) = header with name of the fields
; MAGRY(3) = "^" delimited pairs with internal and external values of the fields listed in MAGRY(1)
; MAGRY(n) = "WordProcesingFieldxxx^line value"
; MAGRY(m) = "MultipleField000^fields header"
; MAGRY(m..m+1) = "MultipleField001^fields values listed in MAGRY(m)"
;
GRECBYPK(MAGRY,FILE,PK,FLAGS,CNT) ;
N FIELDS,FLDSARR,FLDSARRW
N OUT,ERR,TMPOUT,IENS,CNTSTART
N I,J,WPTYPE,SUBFILE
N RESDEL
S RESDEL=$$RESDEL^MAGNU002()
S FIELDS=$$GETFLDS^MAGNU001(.FLDSARR,.FLDSARRW,FILE,"") ; file fields names
S IENS=PK_","
D GETS^DIQ(FILE,PK_",","**","IE","OUT","ERR")
;
I $$ISERROR^MAGNU002(.MAGRY,.ERR) Q ; Set MAGOUT and quit if error exists
;
; Output the data
S CNT=CNT+2 ; 1 is for the header, 2 is the first record with values
S CNTSTART=CNT
S MAGRY(CNT)=PK
S J=""
F S J=$O(FLDSARR(J)) Q:J="" D
. S MAGRY(CNT)=MAGRY(CNT)_RESDEL_OUT(FILE,IENS,J,"I")_RESDEL_OUT(FILE,IENS,J,"E")
. Q
; Now get the word-processing and multiple fields
S J=""
F S J=$O(FLDSARRW(J)) Q:J="" D
. I $$ISFLDWP^MAGNU001(.WPTYPE,FILE,J) D Q
. . Q:'$F(FLAGS,"W") ; Exclude word-processing fields
. . K TMPOUT
. . M TMPOUT=OUT(FILE,IENS,J)
. . D WORDPROC(.MAGRY,.CNT,.TMPOUT,FLDSARRW(J)) ; get word-processing field value
. . Q
. ; multi field
. D MULTI(.MAGRY,.CNT,.OUT,FILE,FLDSARRW(J),FLAGS)
. Q
;
; write the header
S MAGRY(CNTSTART-1)="IEN"
S I=""
F S I=$O(FLDSARR(I)) Q:I="" S MAGRY(CNTSTART-1)=MAGRY(CNTSTART-1)_RESDEL_FLDSARR(I)
S MAGRY(0)=$$SETOKVAL^MAGNU002(CNT)
Q
;
WORDPROC(MAGRY,CNT,WP,FLDNAME) ; add word-processing field values to the result
N L,RESDEL
S RESDEL=$$RESDEL^MAGNU002()
S L=""
F S L=$O(WP(L)) Q:'L D
. S CNT=CNT+1,MAGRY(CNT)=FLDNAME_$TR($J(L,3)," ",0)_RESDEL_WP(L)
. Q
Q
;
MULTI(MAGRY,CNT,OUT,FILE,FLDNAME,FLAGS) ; add word-processing field values to the result
N IEN,J,L,RESDEL
N SUBFILE,FIELDS,FLDSARR,FLDSARRW
;
S RESDEL=$$RESDEL^MAGNU002()
S SUBFILE=$$GSUBFILE^MAGNU001(FILE,FLDNAME) ; get sub-file number
S FIELDS=$$GETFLDS^MAGNU001(.FLDSARR,.FLDSARRW,SUBFILE,"")
; write header of multiple record
S CNT=CNT+1,MAGRY(CNT)=FLDNAME_"000"_RESDEL_"IEN"
S J=""
F S J=$O(FLDSARR(J)) Q:J="" S MAGRY(CNT)=MAGRY(CNT)_RESDEL_FLDSARR(J)
;
; write the values of the multiple record
S L=""
F S L=$O(OUT(SUBFILE,L)) Q:L="" D
. I '$F(FLAGS,"D") Q:$G(OUT(SUBFILE,L,5,"I")) ; Skip deleted annotations
. I '$F(FLAGS,"U") Q:OUT(SUBFILE,L,1,"I")'=DUZ ; Skip deleted annotations
. S IEN=$P(L,",") ; IEN of the mutliple record
. S CNT=CNT+1,MAGRY(CNT)=FLDNAME_$TR($J(IEN,3)," ",0)_RESDEL_IEN
. S J=""
. F S J=$O(FLDSARR(J)) Q:J="" D
. . S MAGRY(CNT)=MAGRY(CNT)_RESDEL_OUT(SUBFILE,L,J,"I")_RESDEL_OUT(SUBFILE,L,J,"E")
. . Q
. S J=""
. F S J=$O(FLDSARRW(J)) Q:J="" D
. . I $$ISFLDWP^MAGNU001(.WPTYPE,SUBFILE,J) D Q
. . . Q:'$F(FLAGS,"W") ; skip word processing field
. . . K TMPOUT
. . . M TMPOUT=OUT(SUBFILE,L,J)
. . . D WORDPROC(.MAGRY,.CNT,.TMPOUT,FLDSARRW(J)) ; get word-processing field value
. . . Q
. . ; multi field
. . D MULTI(.MAGRY,.CNT,.OUT,SUBFILE,FLDSARRW(J),FLAGS)
. . Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGNAU03 4899 printed Oct 16, 2024@18:07:53 Page 2
MAGNAU03 ;WOIFO/NST - Utilities for RPC calls ; 29 Jun 2017 4:16 PM
+1 ;;3.0;IMAGING;**185**;Mar 19, 2002;Build 92;Aug 02, 2012
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ;
+19 ; **** Get a record from a file by IEN
+20 ;
+21 ; Input parameters
+22 ; ================
+23 ;
+24 ; FILE = FileMan number of the file (e.g. 2005.003)
+25 ; PK = IEN in the file
+26 ; FLAGS
+27 ; D - exclude deleted annotations
+28 ; U - include all user's annotations
+29 ; W - include word processing fields
+30 ; CNT = First node in output array
+31 ;
+32 ; Return Values
+33 ; =============
+34 ; if error found during execution
+35 ; MAGRY(0) = Failure status^Error getting values
+36 ; if success
+37 ; MAGRY(0) = Success status^^Total lines
+38 ; MAGRY(1) = header with name of the fields
+39 ; MAGRY(3) = "^" delimited pairs with internal and external values of the fields listed in MAGRY(1)
+40 ; MAGRY(n) = "WordProcesingFieldxxx^line value"
+41 ; MAGRY(m) = "MultipleField000^fields header"
+42 ; MAGRY(m..m+1) = "MultipleField001^fields values listed in MAGRY(m)"
+43 ;
GRECBYPK(MAGRY,FILE,PK,FLAGS,CNT) ;
+1 NEW FIELDS,FLDSARR,FLDSARRW
+2 NEW OUT,ERR,TMPOUT,IENS,CNTSTART
+3 NEW I,J,WPTYPE,SUBFILE
+4 NEW RESDEL
+5 SET RESDEL=$$RESDEL^MAGNU002()
+6 ; file fields names
SET FIELDS=$$GETFLDS^MAGNU001(.FLDSARR,.FLDSARRW,FILE,"")
+7 SET IENS=PK_","
+8 DO GETS^DIQ(FILE,PK_",","**","IE","OUT","ERR")
+9 ;
+10 ; Set MAGOUT and quit if error exists
IF $$ISERROR^MAGNU002(.MAGRY,.ERR)
QUIT
+11 ;
+12 ; Output the data
+13 ; 1 is for the header, 2 is the first record with values
SET CNT=CNT+2
+14 SET CNTSTART=CNT
+15 SET MAGRY(CNT)=PK
+16 SET J=""
+17 FOR
SET J=$ORDER(FLDSARR(J))
if J=""
QUIT
Begin DoDot:1
+18 SET MAGRY(CNT)=MAGRY(CNT)_RESDEL_OUT(FILE,IENS,J,"I")_RESDEL_OUT(FILE,IENS,J,"E")
+19 QUIT
End DoDot:1
+20 ; Now get the word-processing and multiple fields
+21 SET J=""
+22 FOR
SET J=$ORDER(FLDSARRW(J))
if J=""
QUIT
Begin DoDot:1
+23 IF $$ISFLDWP^MAGNU001(.WPTYPE,FILE,J)
Begin DoDot:2
+24 ; Exclude word-processing fields
if '$FIND(FLAGS,"W")
QUIT
+25 KILL TMPOUT
+26 MERGE TMPOUT=OUT(FILE,IENS,J)
+27 ; get word-processing field value
DO WORDPROC(.MAGRY,.CNT,.TMPOUT,FLDSARRW(J))
+28 QUIT
End DoDot:2
QUIT
+29 ; multi field
+30 DO MULTI(.MAGRY,.CNT,.OUT,FILE,FLDSARRW(J),FLAGS)
+31 QUIT
End DoDot:1
+32 ;
+33 ; write the header
+34 SET MAGRY(CNTSTART-1)="IEN"
+35 SET I=""
+36 FOR
SET I=$ORDER(FLDSARR(I))
if I=""
QUIT
SET MAGRY(CNTSTART-1)=MAGRY(CNTSTART-1)_RESDEL_FLDSARR(I)
+37 SET MAGRY(0)=$$SETOKVAL^MAGNU002(CNT)
+38 QUIT
+39 ;
WORDPROC(MAGRY,CNT,WP,FLDNAME) ; add word-processing field values to the result
+1 NEW L,RESDEL
+2 SET RESDEL=$$RESDEL^MAGNU002()
+3 SET L=""
+4 FOR
SET L=$ORDER(WP(L))
if 'L
QUIT
Begin DoDot:1
+5 SET CNT=CNT+1
SET MAGRY(CNT)=FLDNAME_$TRANSLATE($JUSTIFY(L,3)," ",0)_RESDEL_WP(L)
+6 QUIT
End DoDot:1
+7 QUIT
+8 ;
MULTI(MAGRY,CNT,OUT,FILE,FLDNAME,FLAGS) ; add word-processing field values to the result
+1 NEW IEN,J,L,RESDEL
+2 NEW SUBFILE,FIELDS,FLDSARR,FLDSARRW
+3 ;
+4 SET RESDEL=$$RESDEL^MAGNU002()
+5 ; get sub-file number
SET SUBFILE=$$GSUBFILE^MAGNU001(FILE,FLDNAME)
+6 SET FIELDS=$$GETFLDS^MAGNU001(.FLDSARR,.FLDSARRW,SUBFILE,"")
+7 ; write header of multiple record
+8 SET CNT=CNT+1
SET MAGRY(CNT)=FLDNAME_"000"_RESDEL_"IEN"
+9 SET J=""
+10 FOR
SET J=$ORDER(FLDSARR(J))
if J=""
QUIT
SET MAGRY(CNT)=MAGRY(CNT)_RESDEL_FLDSARR(J)
+11 ;
+12 ; write the values of the multiple record
+13 SET L=""
+14 FOR
SET L=$ORDER(OUT(SUBFILE,L))
if L=""
QUIT
Begin DoDot:1
+15 ; Skip deleted annotations
IF '$FIND(FLAGS,"D")
if $GET(OUT(SUBFILE,L,5,"I"))
QUIT
+16 ; Skip deleted annotations
IF '$FIND(FLAGS,"U")
if OUT(SUBFILE,L,1,"I")'=DUZ
QUIT
+17 ; IEN of the mutliple record
SET IEN=$PIECE(L,",")
+18 SET CNT=CNT+1
SET MAGRY(CNT)=FLDNAME_$TRANSLATE($JUSTIFY(IEN,3)," ",0)_RESDEL_IEN
+19 SET J=""
+20 FOR
SET J=$ORDER(FLDSARR(J))
if J=""
QUIT
Begin DoDot:2
+21 SET MAGRY(CNT)=MAGRY(CNT)_RESDEL_OUT(SUBFILE,L,J,"I")_RESDEL_OUT(SUBFILE,L,J,"E")
+22 QUIT
End DoDot:2
+23 SET J=""
+24 FOR
SET J=$ORDER(FLDSARRW(J))
if J=""
QUIT
Begin DoDot:2
+25 IF $$ISFLDWP^MAGNU001(.WPTYPE,SUBFILE,J)
Begin DoDot:3
+26 ; skip word processing field
if '$FIND(FLAGS,"W")
QUIT
+27 KILL TMPOUT
+28 MERGE TMPOUT=OUT(SUBFILE,L,J)
+29 ; get word-processing field value
DO WORDPROC(.MAGRY,.CNT,.TMPOUT,FLDSARRW(J))
+30 QUIT
End DoDot:3
QUIT
+31 ; multi field
+32 DO MULTI(.MAGRY,.CNT,.OUT,SUBFILE,FLDSARRW(J),FLAGS)
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 QUIT
