- 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 Jan 18, 2025@03:08:24 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