Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAQDBIM0

VAQDBIM0.m

Go to the documentation of this file.
  1. VAQDBIM0 ;ALB/JRP - MEANS TEST EXTRACTION;1-MAR-93
  1. ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
  1. ; **********
  1. ; * PARTS OF THIS ROUTINE HAVE BEEN COPIED AND ALTERED FROM THE
  1. ; * DGMTSC* ROUTINES. FOR MODULES THIS WAS DONE FOR, A REFERENCE
  1. ; * TO THE DGMTSC* ROUTINE WILL BE INCLUDE.
  1. ; **********
  1. ;
  1. ;INPUT : SCREEN - Screen number
  1. ; ARRAY - Where to store header (full global reference)
  1. ; OFFSET - Where to start adding lines
  1. ; Input also includes all DG* variables required to build
  1. ; the screen header.
  1. ;OUTPUT : n - Number of lines in display
  1. ; -1^Error_text - Error
  1. ;
  1. ;This module is based on HD^DGMTSCU
  1. ;
  1. ;CHECK INPUT
  1. Q:('$D(SCREEN)) "-1^Screen number not passed"
  1. Q:('$D(ARRAY)) "-1^Reference to output array not passed"
  1. Q:('$D(OFFSET)) "-1^Offset not passed"
  1. ;DECLARE VARIABLES
  1. N TMP,INFO,Y,LINES
  1. S LINES=OFFSET
  1. S TMP=$G(DGMTSC(SCREEN))
  1. Q:(TMP="") "-1^Could not determine header information"
  1. S INFO="----- "_$P(TMP,";",2)_" -----"
  1. S TMP=((80-$L(INFO))\2)+1
  1. S @ARRAY@("DISPLAY",OFFSET,0)=$$INSERT^VAQUTL1(INFO,"",TMP)
  1. S OFFSET=OFFSET+1
  1. S @ARRAY@("DISPLAY",OFFSET,0)=""
  1. S OFFSET=OFFSET+1
  1. Q (OFFSET-LINES)
  1. ;
  1. TITLE(ARRAY,OFFSET) ;MAIN TITLE FOR MEANS TEST DATA SEGMENT
  1. ;INPUT : ARRAY - Where to store title (full global reference)
  1. ; OFFSET - Where to start adding lines
  1. ; Input also includes all DG* variables required to build
  1. ; the screen header.
  1. ;OUTPUT : n - Number of lines in display
  1. ; -1^Error_text - Error
  1. ;
  1. ;This module is based on HD^DGMTSCU
  1. ;
  1. ;CHECK INPUT
  1. Q:('$D(ARRAY)) "-1^Reference to output array not passed"
  1. Q:('$D(OFFSET)) "-1^Offset not passed"
  1. ;DECLARE VARIABLES
  1. N TMP,INFO,Y,LINES
  1. S LINES=OFFSET
  1. S INFO=$$REPEAT^VAQUTL1("-",79)
  1. S TMP="< Means Test Data >"
  1. S Y=((80-$L(TMP))\2)+1
  1. S INFO=$$INSERT^VAQUTL1(TMP,INFO,Y)
  1. S @ARRAY@("DISPLAY",OFFSET,0)=INFO
  1. S OFFSET=OFFSET+1
  1. S @ARRAY@("DISPLAY",OFFSET,0)=""
  1. S OFFSET=OFFSET+1
  1. S INFO="ANNUAL INCOME FOR "
  1. S Y=$$LYR^DGMTSCU1(DGMTDT) X ^DD("DD") S INFO=INFO_Y
  1. S Y=((80-$L(INFO))\2)+1
  1. S INFO=$$INSERT^VAQUTL1(INFO,"",Y)
  1. S @ARRAY@("DISPLAY",OFFSET,0)=INFO
  1. S OFFSET=OFFSET+1
  1. S TMP=$$DOBFMT^VAQUTL99(DGMTDT,0)
  1. S INFO="MEANS TEST DONE ON "_TMP
  1. S Y=((80-$L(INFO))\2)+1
  1. S INFO=$$INSERT^VAQUTL1(INFO,"",Y)
  1. S @ARRAY@("DISPLAY",OFFSET,0)=INFO
  1. S OFFSET=OFFSET+1
  1. S @ARRAY@("DISPLAY",OFFSET,0)=""
  1. S OFFSET=OFFSET+1
  1. Q (OFFSET-LINES)
  1. ;
  1. ERROR(TRAN,ARRAY,OFFSET,REASON) ;ERROR DISPLAY
  1. ;INPUT : TRAN - Pointer to VAQ - TRANSACTION file
  1. ; ARRAY - Where to store information (full global reference)
  1. ; OFFSET - Line segment started on
  1. ; REASON - Reason for error (optional)
  1. ;OUTPUT : n - Number of lines in display
  1. ; -1^Error_text - Error
  1. ;NOTES : If TRAN>0
  1. ; Encryption is based on the transaction
  1. ; Else
  1. ; Encryption is based ont the parameter file
  1. ;
  1. ;CHECK INPUT
  1. S TRAN=+$G(TRAN)
  1. I (TRAN) Q:('$D(^VAT(394.61,TRAN))) "-1^Did not pass valid pointer to VAQ - TRANSACTION file"
  1. Q:('$D(ARRAY)) "-1^Reference to output array not passed"
  1. Q:('$D(OFFSET)) "-1^Offset not passed"
  1. S REASON=$G(REASON)
  1. ;DECLARE VARIABLES
  1. N TMP,INFO,Y,LINES
  1. S LINES=OFFSET
  1. ;DELETE WHAT HAS BEEN ADDED
  1. S Y=$$KILLARR^VAQUTL1(ARRAY,"DISPLAY",LINES)
  1. Q:(Y) Y
  1. ;CREATE ERROR SEGMENT
  1. S INFO=$$REPEAT^VAQUTL1("-",79)
  1. S TMP="< Means Test Data >"
  1. S Y=((80-$L(TMP))\2)+1
  1. S INFO=$$INSERT^VAQUTL1(TMP,INFO,Y)
  1. S @ARRAY@("DISPLAY",OFFSET,0)=INFO
  1. S OFFSET=OFFSET+1
  1. S @ARRAY@("DISPLAY",OFFSET,0)=""
  1. S OFFSET=OFFSET+1
  1. S TMP="Unable to extract Means Test data"
  1. S Y=((80-$L(TMP))\2)+1
  1. S INFO=$$INSERT^VAQUTL1(TMP,"",Y)
  1. S @ARRAY@("DISPLAY",OFFSET,0)=INFO
  1. S OFFSET=OFFSET+1
  1. I (REASON'="") D
  1. .S REASON="("_REASON_")"
  1. .S Y=((80-$L(REASON))\2)+1
  1. .S INFO=$$INSERT^VAQUTL1(REASON,"",Y)
  1. .S @ARRAY@("DISPLAY",OFFSET,0)=INFO
  1. .S OFFSET=OFFSET+1
  1. F Y=1:1:2 S @ARRAY@("DISPLAY",OFFSET,0)="" S OFFSET=OFFSET+1
  1. ;CHECK TO SEE IF ENCRYPTION IS ON - ENCRYPT ARRAY IF IT IS
  1. S:(TRAN) TMP=$$TRANENC^VAQUTL3(TRAN,0)
  1. S:('TRAN) TMP=$$NCRYPTON^VAQUTL2(0)
  1. S:(TMP) TMP=$$ENCDSP^VAQHSH(TRAN,ARRAY,TMP,LINES,(OFFSET-LINES))
  1. Q (OFFSET-LINES)