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

VAQDIS21.m

Go to the documentation of this file. 
  1. VAQDIS21 ;ALB/JFP - PDX, BUILDS DISPLAY ARRAY FOR MINIMAL DATA ;01MAR93
  1.  ;;1.5;PATIENT DATA EXCHANGE;**13**;NOV 17, 1993
  1. DISPMIN(XTRCT,SEGPTR,ROOT,OFFSET,DSP) ;SAMPLE DISPLAY METHOD
  1.  ;INPUT : XTRCT  - Input array (full global reference)
  1.  ;        SEGPTR - Segment to extract (ptr to file #394.71)
  1.  ;        ROOT   - Output array (full global reference)
  1.  ;        OFFSET - Starting line for display
  1.  ;        DSP    - Flag to set display option (1-on,0-off)
  1.  ;OUTPUT: n      - Number of lines added to display
  1.  ;       -1^ErrorText - Error
  1.  ;
  1.  ; -- Check input
  1.  Q:('$D(XTRCT)) "-1^Input array not passed on input"
  1.  Q:('$D(SEGPTR)) "-1^Segment not passed on input"
  1.  Q:('$D(ROOT)) "-1^Output array not passed on input"
  1.  Q:('$D(OFFSET)) "-1^Starting line for display not passed on input"
  1.  ;
  1.  S:('$D(DSP)) DSP=1
  1.  ; -- Declare variables
  1.  N X,SEGMENT,VAQPTAGE,VAQCNTY,STDA,CTDA,VAQST,VALMCNT,SSN
  1.  N COUNTY,CNTYNUM,CNTYINFO
  1.  ;
  1.  S VAQSEGND=$G(^VAT(394.71,SEGPTR,0))
  1.  Q:($P(VAQSEGND,U,2)="") "-1^Invalid segment"
  1.  S VALMCNT=$S(DSP=1:OFFSET-1,1:0)
  1.  I DSP=1 S ROOT=$$ROOT^VAQDIS20(ROOT)
  1.  I DSP=0 G ROW1
  1.  ;
  1.  ; -- Build display segment
  1. ROW0 ; -- Header line for display, only
  1.  S VAQLN=$$REPEAT^VAQUTL1("-",79)
  1.  S VAQCTR="< "_$S($P(VAQSEGND,"^",1)'="":$P(VAQSEGND,"^",1),1:"Segment  Description Missing")_" >"
  1.  S X=$$CENTER^VAQDIS20(VAQLN,VAQCTR) D TMP,BLANK
  1.  K VAQLN,VAQCTR,VAQSEGND
  1.  ;
  1. ROW1 S X=$$SETSTR^VALM1("PAT Name: "_$G(@XTRCT@("VALUE",2,.01,0)),"",1,40)
  1.  S X=$$SETSTR^VALM1("DOB: "_$G(@XTRCT@("VALUE",2,.03,0)),X,43,22)
  1.  S VAQPTAGE=$S($G(@XTRCT@("VALUE",2,.03,0))'="":$$AGE^VAQUTL99($$DATE^VAQUTL99($G(@XTRCT@("VALUE",2,.03,0)))),1:" ")
  1.  S X=$$SETSTR^VALM1("AGE: "_VAQPTAGE,X,64,14)
  1.  D TMP K VAQPTAGE
  1.  ;
  1. ROW2 S X=$$SETSTR^VALM1("    Addr: "_$G(@XTRCT@("VALUE",2,.111,0)),"",1,40)
  1.  S SSN=$$DASHSSN^VAQUTL99($G(@XTRCT@("VALUE",2,.09,0)))
  1.  S X=$$SETSTR^VALM1("SSN: "_SSN,X,43,16)
  1.  D TMP
  1.  ;
  1. ROW3 S X=$$SETSTR^VALM1("        : "_$G(@XTRCT@("VALUE",2,.112,0)),"",1,40)
  1.  S X=$$SETSTR^VALM1("Sex: "_$G(@XTRCT@("VALUE",2,.02,0)),X,43,12)
  1.  S X=$$SETSTR^VALM1("MS: "_$G(@XTRCT@("VALUE",2,.05,0)),X,65,14)
  1.  D TMP
  1.  ;
  1. ROW4 S X=$$SETSTR^VALM1("        : "_$G(@XTRCT@("VALUE",2,.113,0)),"",1,40)
  1.  S X=$$SETSTR^VALM1("Religion: "_$G(@XTRCT@("VALUE",2,.08,0)),X,43,30)
  1.  D TMP
  1.  ;
  1. ROW5 S STDA="",ST=$G(@XTRCT@("VALUE",2,.115,0))
  1.  S:ST'="" STDA=$O(^DIC(5,"B",$G(@XTRCT@("VALUE",2,.115,0)),STDA))
  1.  S VAQST=$S(STDA'="":$P(^DIC(5,STDA,0),U,2),1:" ")
  1.  S CTDA="",CT=$G(@XTRCT@("VALUE",2,.117,0))
  1.  I (CT'="")&(STDA'="") S CTDA=$O(^DIC(5,STDA,1,"C",$G(@XTRCT@("VALUE",2,.117,0)),CTDA))
  1.  S X=$$SETSTR^VALM1("City/ST: "_$G(@XTRCT@("VALUE",2,.114,0))_$S(ST="":" ",1:", ")_VAQST,"",2,39)
  1.  D TMP K STDA,ST,VAQST,CTDA,CT
  1.  ;
  1. ROW6 S X=$$SETSTR^VALM1("Zip: "_$G(@XTRCT@("VALUE",2,.1112,0)),"",6,15)
  1.  S X=$$SETSTR^VALM1("County: ",X,43,8)
  1.  S CNTYNUM=$G(@XTRCT@("VALUE",2,.117,0))
  1.  S COUNTY=$$COUNTY^VAQDIS20($G(@XTRCT@("VALUE",2,.115,0)),CNTYNUM)
  1.  S CNTYINFO=COUNTY_"  ("_CNTYNUM_")"
  1.  S:(COUNTY="") CNTYINFO="UNKNOWN  ("_CNTYNUM_")"
  1.  S:((COUNTY="")&(CNTYNUM="")) CNTYINFO="UNANSWERED"
  1.  S X=X_CNTYINFO
  1.  D TMP
  1.  ;
  1. ROW7 S X=$$SETSTR^VALM1(" ","",1,80) D TMP ; -- null line
  1. ROW8 S X=$$SETSTR^VALM1("     Patient Type: "_$G(@XTRCT@("VALUE",2,391,0)),"",1,40)
  1.  S X=$$SETSTR^VALM1("Veteran: "_$G(@XTRCT@("VALUE",2,1901,0)),X,43,13) D TMP
  1. ROW9 S X=$$SETSTR^VALM1("Period of Service: "_$G(@XTRCT@("VALUE",2,.323,0)),"",1,40) D TMP
  1. ROW10 S X=$$SETSTR^VALM1("Service Connected: "_$G(@XTRCT@("VALUE",2,.301,0)),"",1,40)
  1.  S X=$$SETSTR^VALM1("Percentage: "_$G(@XTRCT@("VALUE",2,.302,0))_"%",X,43,36) D TMP
  1. ROW11 S X=$$SETSTR^VALM1("      Eligibility: "_$G(@XTRCT@("VALUE",2,.361,0)),"",1,40) D TMP,BLANK
  1.  D BLANK
  1.  ; -- Sets number of lines in display
  1.  QUIT VALMCNT-OFFSET
  1.  ;
  1. BLANK ; -- Sets up blank line
  1.  S X=$$SETSTR^VALM1(" ","",1,80) D TMP ; -- null line
  1.  QUIT
  1.  ;
  1. TMP ; -- Sets up display array
  1.  S VALMCNT=VALMCNT+1
  1.  S @ROOT@(VALMCNT,0)=$E(X,1,79)
  1.  QUIT
  1.  ;
  1. END ; -- End of code
  1.  QUIT