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

VAQDIS26.m

Go to the documentation of this file.
VAQDIS26 ;ALB/JFP - PDX, BUILDS DISPLAY ARRAY FOR MAS DATA ;01MAR93
 ;;1.5;PATIENT DATA EXCHANGE;**13**;NOV 17, 1993
SCR3 ; -- Builds MAS DATA SCREEN 3 CONTINUE, EMERGENCY CONTACT
ROW0 ; -- Header
 S VAQLN=$$REPEAT^VAQUTL1(" ",79)
 S VAQCTR=" -- EMERGENCY CONTACT -- "
 S X=$$CENTER^VAQDIS20(VAQLN,VAQCTR)
 D TMP,BLANK^VAQDIS20
 K VAQLN,VAQCTR
ROW1 ;
 S VAQTMP=$G(@XTRCT@("VALUE",2,.331,0))
 S VAQINF=$S(VAQTMP="":"UNANSWERED",1:VAQTMP)
 S X=$$SETSTR^VALM1("E-Cont: "_VAQINF,"",7,37)
 S VAQTMP=$G(@XTRCT@("VALUE",2,.3311,0))
 S VAQINF=$S(VAQTMP="":"UNANSWERED",1:VAQTMP)
 S X=$$SETSTR^VALM1("E2-Cont: "_VAQINF,X,45,34)
 D TMP K VAQTMP,VAQINF
ROW2 ;
 S VAQTMP=$G(@XTRCT@("VALUE",2,.332,0))
 S VAQINF=$S(VAQTMP="":"UNANSWERED",1:VAQTMP)
 S X=$$SETSTR^VALM1("Relation: "_VAQINF,"",5,43)
 S VAQTMP=$G(@XTRCT@("VALUE",2,.3312,0))
 S VAQINF=$S(VAQTMP="":"UNANSWERED",1:VAQTMP)
 S X=$$SETSTR^VALM1("Relation: "_VAQINF,X,44,37)
 D TMP K VAQTMP,VAQINF
 ;
EMER ; Emergency contact address
 K ADDR
 S VAQTMP=1
 F VAQX=.333,.334,.335 D  Q:(VAQINF="")
 .S VAQINF=$G(@XTRCT@("VALUE",2,VAQX,0))
 .I ((VAQX=.333)&(VAQINF="")) S VAQINF="STREET ADDRESS UNKNOWN"
 .Q:(VAQINF="")
 .S ADDR(VAQTMP)=VAQINF
 .S VAQTMP=VAQTMP+1
 S CTY=$G(@XTRCT@("VALUE",2,.336,0))
 S ZIP=$G(@XTRCT@("VALUE",2,.2201,0))
 S STATE=$$STATE^VAQDIS20($G(@XTRCT@("VALUE",2,.337,0)))
 S VAQINF=$S((CTY="")&(STATE="")&(ZIP=""):"CITY/STATE/ZIP UNKNOWN",1:CTY_$S(STATE="":" ",1:", ")_STATE_" "_ZIP)
 S ADDR(VAQTMP)=VAQINF
EMER2 ;Emergency contact 2 address
 K ADDRT
 S VAQTMP=1
 F VAQX=.3313,.3314,.3315 D  Q:(VAQINF="")
 .S VAQINF=$G(@XTRCT@("VALUE",2,VAQX,0))
 .I ((VAQX=.2193)&(VAQINF="")) S VAQINF="STREET ADDRESS UNKNOWN"
 .Q:(VAQINF="")
 .S ADDRT(VAQTMP)=VAQINF
 .S VAQTMP=VAQTMP+1
 S CTY=$G(@XTRCT@("VALUE",2,.3316,0))
 S ZIP=$G(@XTRCT@("VALUE",2,.2204,0))
 S STATE=$$STATE^VAQDIS20($G(@XTRCT@("VALUE",2,.3317,0)))
 S VAQINF=$S((CTY="")&(STATE="")&(ZIP=""):"CITY/STATE/ZIP UNKNOWN",1:CTY_$S(STATE="":" ",1:", ")_STATE_" "_ZIP)
 S ADDRT(VAQTMP)=VAQINF
 D ADRLOAD
 K ADDR,ADDRT,VAQTMP,VAQINF,VAQX,CTY,STATE,ZIP
 ;
ROW5 ; -- Phone
 S VAQTMP=$G(@XTRCT@("VALUE",2,.339,0))
 S VAQINF=$S(VAQTMP="":"UNANSWERED",1:VAQTMP)
 S X=$$SETSTR^VALM1("Phone: "_VAQINF,"",8,46)
 S VAQTMP=$G(@XTRCT@("VALUE",2,.3319,0))
 S VAQINF=$S(VAQTMP="":"UNANSWERED",1:VAQTMP)
 S X=$$SETSTR^VALM1("Phone: "_VAQINF,X,47,32)
 D TMP K VAQTMP,VAQINF
 ;
ROW6 ; -- Work Phone
 S VAQTMP=$G(@XTRCT@("VALUE",2,.33011,0))
 S VAQINF=$S(VAQTMP="":"UNANSWERED",1:VAQTMP)
 S X=$$SETSTR^VALM1("Work Phone: "_VAQINF,"",3,41)
 S VAQTMP=$G(@XTRCT@("VALUE",2,.331011,0))
 S VAQINF=$S(VAQTMP="":"UNANSWERED",1:VAQTMP)
 S X=$$SETSTR^VALM1("Work Phone: "_VAQINF,X,42,37)
 D TMP K VAQTMP,VAQINF
 D BLANK^VAQDIS20
ROW7 ;
 S VAQTMP=$G(@XTRCT@("VALUE",2,.341,0))
 S VAQINF=$S(VAQTMP="":"UNANSWERED",1:VAQTMP)
 S X=$$SETSTR^VALM1("Designee: "_VAQINF,"",5,36)
 S VAQTMP=$G(@XTRCT@("VALUE",2,.342,0))
 S VAQINF=$S(VAQTMP="":"UNANSWERED",1:VAQTMP)
 S X=$$SETSTR^VALM1("Relation: "_VAQINF,X,44,37)
 D TMP K VAQTMP,VAQINF
 ;
ROW8 ; -- Address line 1,2,3
 F VAQX=.343,.344,.345 D
 .S VAQINF=$G(@XTRCT@("VALUE",2,VAQX,0))
 .S:((VAQX=.343)&(VAQINF="")) VAQINF="STREET ADDRESS UNKNOWN"
 .Q:(VAQINF="")
 .S X=$$SETSTR^VALM1(VAQINF,"",15,53)
 .D TMP
 K VAQTMP,VAQINF,VAQFLAG,VAQX
 ;
ROW9 ; -- (city,state,zip)
 S CTY=$G(@XTRCT@("VALUE",2,.346,0))
 S ZIP=$G(@XTRCT@("VALUE",2,.2202,0))
 S STATE=$$STATE^VAQDIS20($G(@XTRCT@("VALUE",2,.347,0)))
 S VAQINF=$S((CTY="")&(STATE="")&(ZIP=""):"CITY/STATE/ZIP UNKNOWN",1:CTY_$S(STATE="":" ",1:", ")_STATE_" "_ZIP)
 S X=$$SETSTR^VALM1(VAQINF,"",15,53)
 D TMP K CTY,STATE,ZIP,VAQINF
 ;
ROW10 ;
 S VAQTMP=$G(@XTRCT@("VALUE",2,.349,0))
 S VAQINF=$S(VAQTMP="":"UNANSWERED",1:VAQTMP)
 S X=$$SETSTR^VALM1("Phone: "_VAQINF,"",8,34)
 S VAQTMP=$G(@XTRCT@("VALUE",2,.34011,0))
 S VAQINF=$S(VAQTMP="":"UNANSWERED",1:VAQTMP)
 S X=$$SETSTR^VALM1("Work Phone: "_VAQINF,X,42,37)
 D TMP K VAQTMP,VAQINF
 ;
EXIT ; -- Sets the number of lines in display
 QUIT
 ;
ADRLOAD ; -- Loads address into display array
 F VAQX=1:1:4 D
 .S VAQINF=""
 .S:($D(ADDR(VAQX))) VAQINF=$$SETSTR^VALM1(ADDR(VAQX),VAQINF,15,53)
 .S:($D(ADDRT(VAQX))) VAQINF=$$SETSTR^VALM1(ADDRT(VAQX),VAQINF,54,25)
 .Q:(VAQINF="")
 .S VALMCNT=VALMCNT+1
 .S @ROOT@(VALMCNT,0)=$E(VAQINF,1,79)
 Q
 ;
TMP ; -- Sets up display array
 S VALMCNT=VALMCNT+1
 S @ROOT@(VALMCNT,0)=$E(X,1,79)
 QUIT
 ;
END ; -- End of code
 QUIT