- VAQDBIM0 ;ALB/JRP - MEANS TEST EXTRACTION;1-MAR-93
- ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
- ; **********
- ; * PARTS OF THIS ROUTINE HAVE BEEN COPIED AND ALTERED FROM THE
- ; * DGMTSC* ROUTINES. FOR MODULES THIS WAS DONE FOR, A REFERENCE
- ; * TO THE DGMTSC* ROUTINE WILL BE INCLUDE.
- ; **********
- ;
- ;INPUT : SCREEN - Screen number
- ; ARRAY - Where to store header (full global reference)
- ; OFFSET - Where to start adding lines
- ; Input also includes all DG* variables required to build
- ; the screen header.
- ;OUTPUT : n - Number of lines in display
- ; -1^Error_text - Error
- ;
- ;This module is based on HD^DGMTSCU
- ;
- ;CHECK INPUT
- Q:('$D(SCREEN)) "-1^Screen number not passed"
- Q:('$D(ARRAY)) "-1^Reference to output array not passed"
- Q:('$D(OFFSET)) "-1^Offset not passed"
- ;DECLARE VARIABLES
- N TMP,INFO,Y,LINES
- S LINES=OFFSET
- S TMP=$G(DGMTSC(SCREEN))
- Q:(TMP="") "-1^Could not determine header information"
- S INFO="----- "_$P(TMP,";",2)_" -----"
- S TMP=((80-$L(INFO))\2)+1
- S @ARRAY@("DISPLAY",OFFSET,0)=$$INSERT^VAQUTL1(INFO,"",TMP)
- S OFFSET=OFFSET+1
- S @ARRAY@("DISPLAY",OFFSET,0)=""
- S OFFSET=OFFSET+1
- Q (OFFSET-LINES)
- ;
- TITLE(ARRAY,OFFSET) ;MAIN TITLE FOR MEANS TEST DATA SEGMENT
- ;INPUT : ARRAY - Where to store title (full global reference)
- ; OFFSET - Where to start adding lines
- ; Input also includes all DG* variables required to build
- ; the screen header.
- ;OUTPUT : n - Number of lines in display
- ; -1^Error_text - Error
- ;
- ;This module is based on HD^DGMTSCU
- ;
- ;CHECK INPUT
- Q:('$D(ARRAY)) "-1^Reference to output array not passed"
- Q:('$D(OFFSET)) "-1^Offset not passed"
- ;DECLARE VARIABLES
- N TMP,INFO,Y,LINES
- S LINES=OFFSET
- S INFO=$$REPEAT^VAQUTL1("-",79)
- S TMP="< Means Test Data >"
- S Y=((80-$L(TMP))\2)+1
- S INFO=$$INSERT^VAQUTL1(TMP,INFO,Y)
- S @ARRAY@("DISPLAY",OFFSET,0)=INFO
- S OFFSET=OFFSET+1
- S @ARRAY@("DISPLAY",OFFSET,0)=""
- S OFFSET=OFFSET+1
- S INFO="ANNUAL INCOME FOR "
- S Y=$$LYR^DGMTSCU1(DGMTDT) X ^DD("DD") S INFO=INFO_Y
- S Y=((80-$L(INFO))\2)+1
- S INFO=$$INSERT^VAQUTL1(INFO,"",Y)
- S @ARRAY@("DISPLAY",OFFSET,0)=INFO
- S OFFSET=OFFSET+1
- S TMP=$$DOBFMT^VAQUTL99(DGMTDT,0)
- S INFO="MEANS TEST DONE ON "_TMP
- S Y=((80-$L(INFO))\2)+1
- S INFO=$$INSERT^VAQUTL1(INFO,"",Y)
- S @ARRAY@("DISPLAY",OFFSET,0)=INFO
- S OFFSET=OFFSET+1
- S @ARRAY@("DISPLAY",OFFSET,0)=""
- S OFFSET=OFFSET+1
- Q (OFFSET-LINES)
- ;
- ERROR(TRAN,ARRAY,OFFSET,REASON) ;ERROR DISPLAY
- ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
- ; ARRAY - Where to store information (full global reference)
- ; OFFSET - Line segment started on
- ; REASON - Reason for error (optional)
- ;OUTPUT : n - Number of lines in display
- ; -1^Error_text - Error
- ;NOTES : If TRAN>0
- ; Encryption is based on the transaction
- ; Else
- ; Encryption is based ont the parameter file
- ;
- ;CHECK INPUT
- S TRAN=+$G(TRAN)
- I (TRAN) Q:('$D(^VAT(394.61,TRAN))) "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
- Q:('$D(ARRAY)) "-1^Reference to output array not passed"
- Q:('$D(OFFSET)) "-1^Offset not passed"
- S REASON=$G(REASON)
- ;DECLARE VARIABLES
- N TMP,INFO,Y,LINES
- S LINES=OFFSET
- ;DELETE WHAT HAS BEEN ADDED
- S Y=$$KILLARR^VAQUTL1(ARRAY,"DISPLAY",LINES)
- Q:(Y) Y
- ;CREATE ERROR SEGMENT
- S INFO=$$REPEAT^VAQUTL1("-",79)
- S TMP="< Means Test Data >"
- S Y=((80-$L(TMP))\2)+1
- S INFO=$$INSERT^VAQUTL1(TMP,INFO,Y)
- S @ARRAY@("DISPLAY",OFFSET,0)=INFO
- S OFFSET=OFFSET+1
- S @ARRAY@("DISPLAY",OFFSET,0)=""
- S OFFSET=OFFSET+1
- S TMP="Unable to extract Means Test data"
- S Y=((80-$L(TMP))\2)+1
- S INFO=$$INSERT^VAQUTL1(TMP,"",Y)
- S @ARRAY@("DISPLAY",OFFSET,0)=INFO
- S OFFSET=OFFSET+1
- I (REASON'="") D
- .S REASON="("_REASON_")"
- .S Y=((80-$L(REASON))\2)+1
- .S INFO=$$INSERT^VAQUTL1(REASON,"",Y)
- .S @ARRAY@("DISPLAY",OFFSET,0)=INFO
- .S OFFSET=OFFSET+1
- F Y=1:1:2 S @ARRAY@("DISPLAY",OFFSET,0)="" S OFFSET=OFFSET+1
- ;CHECK TO SEE IF ENCRYPTION IS ON - ENCRYPT ARRAY IF IT IS
- S:(TRAN) TMP=$$TRANENC^VAQUTL3(TRAN,0)
- S:('TRAN) TMP=$$NCRYPTON^VAQUTL2(0)
- S:(TMP) TMP=$$ENCDSP^VAQHSH(TRAN,ARRAY,TMP,LINES,(OFFSET-LINES))
- Q (OFFSET-LINES)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDBIM0 4319 printed Jan 18, 2025@03:25:45 Page 2
- VAQDBIM0 ;ALB/JRP - MEANS TEST EXTRACTION;1-MAR-93
- +1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
- +2 ; **********
- +3 ; * PARTS OF THIS ROUTINE HAVE BEEN COPIED AND ALTERED FROM THE
- +4 ; * DGMTSC* ROUTINES. FOR MODULES THIS WAS DONE FOR, A REFERENCE
- +5 ; * TO THE DGMTSC* ROUTINE WILL BE INCLUDE.
- +6 ; **********
- +7 ;
- +1 ;INPUT : SCREEN - Screen number
- +2 ; ARRAY - Where to store header (full global reference)
- +3 ; OFFSET - Where to start adding lines
- +4 ; Input also includes all DG* variables required to build
- +5 ; the screen header.
- +6 ;OUTPUT : n - Number of lines in display
- +7 ; -1^Error_text - Error
- +8 ;
- +9 ;This module is based on HD^DGMTSCU
- +10 ;
- +11 ;CHECK INPUT
- +12 if ('$DATA(SCREEN))
- QUIT "-1^Screen number not passed"
- +13 if ('$DATA(ARRAY))
- QUIT "-1^Reference to output array not passed"
- +14 if ('$DATA(OFFSET))
- QUIT "-1^Offset not passed"
- +15 ;DECLARE VARIABLES
- +16 NEW TMP,INFO,Y,LINES
- +17 SET LINES=OFFSET
- +18 SET TMP=$GET(DGMTSC(SCREEN))
- +19 if (TMP="")
- QUIT "-1^Could not determine header information"
- +20 SET INFO="----- "_$PIECE(TMP,";",2)_" -----"
- +21 SET TMP=((80-$LENGTH(INFO))\2)+1
- +22 SET @ARRAY@("DISPLAY",OFFSET,0)=$$INSERT^VAQUTL1(INFO,"",TMP)
- +23 SET OFFSET=OFFSET+1
- +24 SET @ARRAY@("DISPLAY",OFFSET,0)=""
- +25 SET OFFSET=OFFSET+1
- +26 QUIT (OFFSET-LINES)
- +27 ;
- TITLE(ARRAY,OFFSET) ;MAIN TITLE FOR MEANS TEST DATA SEGMENT
- +1 ;INPUT : ARRAY - Where to store title (full global reference)
- +2 ; OFFSET - Where to start adding lines
- +3 ; Input also includes all DG* variables required to build
- +4 ; the screen header.
- +5 ;OUTPUT : n - Number of lines in display
- +6 ; -1^Error_text - Error
- +7 ;
- +8 ;This module is based on HD^DGMTSCU
- +9 ;
- +10 ;CHECK INPUT
- +11 if ('$DATA(ARRAY))
- QUIT "-1^Reference to output array not passed"
- +12 if ('$DATA(OFFSET))
- QUIT "-1^Offset not passed"
- +13 ;DECLARE VARIABLES
- +14 NEW TMP,INFO,Y,LINES
- +15 SET LINES=OFFSET
- +16 SET INFO=$$REPEAT^VAQUTL1("-",79)
- +17 SET TMP="< Means Test Data >"
- +18 SET Y=((80-$LENGTH(TMP))\2)+1
- +19 SET INFO=$$INSERT^VAQUTL1(TMP,INFO,Y)
- +20 SET @ARRAY@("DISPLAY",OFFSET,0)=INFO
- +21 SET OFFSET=OFFSET+1
- +22 SET @ARRAY@("DISPLAY",OFFSET,0)=""
- +23 SET OFFSET=OFFSET+1
- +24 SET INFO="ANNUAL INCOME FOR "
- +25 SET Y=$$LYR^DGMTSCU1(DGMTDT)
- XECUTE ^DD("DD")
- SET INFO=INFO_Y
- +26 SET Y=((80-$LENGTH(INFO))\2)+1
- +27 SET INFO=$$INSERT^VAQUTL1(INFO,"",Y)
- +28 SET @ARRAY@("DISPLAY",OFFSET,0)=INFO
- +29 SET OFFSET=OFFSET+1
- +30 SET TMP=$$DOBFMT^VAQUTL99(DGMTDT,0)
- +31 SET INFO="MEANS TEST DONE ON "_TMP
- +32 SET Y=((80-$LENGTH(INFO))\2)+1
- +33 SET INFO=$$INSERT^VAQUTL1(INFO,"",Y)
- +34 SET @ARRAY@("DISPLAY",OFFSET,0)=INFO
- +35 SET OFFSET=OFFSET+1
- +36 SET @ARRAY@("DISPLAY",OFFSET,0)=""
- +37 SET OFFSET=OFFSET+1
- +38 QUIT (OFFSET-LINES)
- +39 ;
- ERROR(TRAN,ARRAY,OFFSET,REASON) ;ERROR DISPLAY
- +1 ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
- +2 ; ARRAY - Where to store information (full global reference)
- +3 ; OFFSET - Line segment started on
- +4 ; REASON - Reason for error (optional)
- +5 ;OUTPUT : n - Number of lines in display
- +6 ; -1^Error_text - Error
- +7 ;NOTES : If TRAN>0
- +8 ; Encryption is based on the transaction
- +9 ; Else
- +10 ; Encryption is based ont the parameter file
- +11 ;
- +12 ;CHECK INPUT
- +13 SET TRAN=+$GET(TRAN)
- +14 IF (TRAN)
- if ('$DATA(^VAT(394.61,TRAN)))
- QUIT "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
- +15 if ('$DATA(ARRAY))
- QUIT "-1^Reference to output array not passed"
- +16 if ('$DATA(OFFSET))
- QUIT "-1^Offset not passed"
- +17 SET REASON=$GET(REASON)
- +18 ;DECLARE VARIABLES
- +19 NEW TMP,INFO,Y,LINES
- +20 SET LINES=OFFSET
- +21 ;DELETE WHAT HAS BEEN ADDED
- +22 SET Y=$$KILLARR^VAQUTL1(ARRAY,"DISPLAY",LINES)
- +23 if (Y)
- QUIT Y
- +24 ;CREATE ERROR SEGMENT
- +25 SET INFO=$$REPEAT^VAQUTL1("-",79)
- +26 SET TMP="< Means Test Data >"
- +27 SET Y=((80-$LENGTH(TMP))\2)+1
- +28 SET INFO=$$INSERT^VAQUTL1(TMP,INFO,Y)
- +29 SET @ARRAY@("DISPLAY",OFFSET,0)=INFO
- +30 SET OFFSET=OFFSET+1
- +31 SET @ARRAY@("DISPLAY",OFFSET,0)=""
- +32 SET OFFSET=OFFSET+1
- +33 SET TMP="Unable to extract Means Test data"
- +34 SET Y=((80-$LENGTH(TMP))\2)+1
- +35 SET INFO=$$INSERT^VAQUTL1(TMP,"",Y)
- +36 SET @ARRAY@("DISPLAY",OFFSET,0)=INFO
- +37 SET OFFSET=OFFSET+1
- +38 IF (REASON'="")
- Begin DoDot:1
- +39 SET REASON="("_REASON_")"
- +40 SET Y=((80-$LENGTH(REASON))\2)+1
- +41 SET INFO=$$INSERT^VAQUTL1(REASON,"",Y)
- +42 SET @ARRAY@("DISPLAY",OFFSET,0)=INFO
- +43 SET OFFSET=OFFSET+1
- End DoDot:1
- +44 FOR Y=1:1:2
- SET @ARRAY@("DISPLAY",OFFSET,0)=""
- SET OFFSET=OFFSET+1
- +45 ;CHECK TO SEE IF ENCRYPTION IS ON - ENCRYPT ARRAY IF IT IS
- +46 if (TRAN)
- SET TMP=$$TRANENC^VAQUTL3(TRAN,0)
- +47 if ('TRAN)
- SET TMP=$$NCRYPTON^VAQUTL2(0)
- +48 if (TMP)
- SET TMP=$$ENCDSP^VAQHSH(TRAN,ARRAY,TMP,LINES,(OFFSET-LINES))
- +49 QUIT (OFFSET-LINES)