- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDIS26 4518 printed Jan 18, 2025@03:26:10 Page 2
- VAQDIS26 ;ALB/JFP - PDX, BUILDS DISPLAY ARRAY FOR MAS DATA ;01MAR93
- +1 ;;1.5;PATIENT DATA EXCHANGE;**13**;NOV 17, 1993
- SCR3 ; -- Builds MAS DATA SCREEN 3 CONTINUE, EMERGENCY CONTACT
- ROW0 ; -- Header
- +1 SET VAQLN=$$REPEAT^VAQUTL1(" ",79)
- +2 SET VAQCTR=" -- EMERGENCY CONTACT -- "
- +3 SET X=$$CENTER^VAQDIS20(VAQLN,VAQCTR)
- +4 DO TMP
- DO BLANK^VAQDIS20
- +5 KILL VAQLN,VAQCTR
- ROW1 ;
- +1 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.331,0))
- +2 SET VAQINF=$SELECT(VAQTMP="":"UNANSWERED",1:VAQTMP)
- +3 SET X=$$SETSTR^VALM1("E-Cont: "_VAQINF,"",7,37)
- +4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.3311,0))
- +5 SET VAQINF=$SELECT(VAQTMP="":"UNANSWERED",1:VAQTMP)
- +6 SET X=$$SETSTR^VALM1("E2-Cont: "_VAQINF,X,45,34)
- +7 DO TMP
- KILL VAQTMP,VAQINF
- ROW2 ;
- +1 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.332,0))
- +2 SET VAQINF=$SELECT(VAQTMP="":"UNANSWERED",1:VAQTMP)
- +3 SET X=$$SETSTR^VALM1("Relation: "_VAQINF,"",5,43)
- +4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.3312,0))
- +5 SET VAQINF=$SELECT(VAQTMP="":"UNANSWERED",1:VAQTMP)
- +6 SET X=$$SETSTR^VALM1("Relation: "_VAQINF,X,44,37)
- +7 DO TMP
- KILL VAQTMP,VAQINF
- +8 ;
- EMER ; Emergency contact address
- +1 KILL ADDR
- +2 SET VAQTMP=1
- +3 FOR VAQX=.333,.334,.335
- Begin DoDot:1
- +4 SET VAQINF=$GET(@XTRCT@("VALUE",2,VAQX,0))
- +5 IF ((VAQX=.333)&(VAQINF=""))
- SET VAQINF="STREET ADDRESS UNKNOWN"
- +6 if (VAQINF="")
- QUIT
- +7 SET ADDR(VAQTMP)=VAQINF
- +8 SET VAQTMP=VAQTMP+1
- End DoDot:1
- if (VAQINF="")
- QUIT
- +9 SET CTY=$GET(@XTRCT@("VALUE",2,.336,0))
- +10 SET ZIP=$GET(@XTRCT@("VALUE",2,.2201,0))
- +11 SET STATE=$$STATE^VAQDIS20($GET(@XTRCT@("VALUE",2,.337,0)))
- +12 SET VAQINF=$SELECT((CTY="")&(STATE="")&(ZIP=""):"CITY/STATE/ZIP UNKNOWN",1:CTY_$SELECT(STATE="":" ",1:", ")_STATE_" "_ZIP)
- +13 SET ADDR(VAQTMP)=VAQINF
- EMER2 ;Emergency contact 2 address
- +1 KILL ADDRT
- +2 SET VAQTMP=1
- +3 FOR VAQX=.3313,.3314,.3315
- Begin DoDot:1
- +4 SET VAQINF=$GET(@XTRCT@("VALUE",2,VAQX,0))
- +5 IF ((VAQX=.2193)&(VAQINF=""))
- SET VAQINF="STREET ADDRESS UNKNOWN"
- +6 if (VAQINF="")
- QUIT
- +7 SET ADDRT(VAQTMP)=VAQINF
- +8 SET VAQTMP=VAQTMP+1
- End DoDot:1
- if (VAQINF="")
- QUIT
- +9 SET CTY=$GET(@XTRCT@("VALUE",2,.3316,0))
- +10 SET ZIP=$GET(@XTRCT@("VALUE",2,.2204,0))
- +11 SET STATE=$$STATE^VAQDIS20($GET(@XTRCT@("VALUE",2,.3317,0)))
- +12 SET VAQINF=$SELECT((CTY="")&(STATE="")&(ZIP=""):"CITY/STATE/ZIP UNKNOWN",1:CTY_$SELECT(STATE="":" ",1:", ")_STATE_" "_ZIP)
- +13 SET ADDRT(VAQTMP)=VAQINF
- +14 DO ADRLOAD
- +15 KILL ADDR,ADDRT,VAQTMP,VAQINF,VAQX,CTY,STATE,ZIP
- +16 ;
- ROW5 ; -- Phone
- +1 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.339,0))
- +2 SET VAQINF=$SELECT(VAQTMP="":"UNANSWERED",1:VAQTMP)
- +3 SET X=$$SETSTR^VALM1("Phone: "_VAQINF,"",8,46)
- +4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.3319,0))
- +5 SET VAQINF=$SELECT(VAQTMP="":"UNANSWERED",1:VAQTMP)
- +6 SET X=$$SETSTR^VALM1("Phone: "_VAQINF,X,47,32)
- +7 DO TMP
- KILL VAQTMP,VAQINF
- +8 ;
- ROW6 ; -- Work Phone
- +1 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.33011,0))
- +2 SET VAQINF=$SELECT(VAQTMP="":"UNANSWERED",1:VAQTMP)
- +3 SET X=$$SETSTR^VALM1("Work Phone: "_VAQINF,"",3,41)
- +4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.331011,0))
- +5 SET VAQINF=$SELECT(VAQTMP="":"UNANSWERED",1:VAQTMP)
- +6 SET X=$$SETSTR^VALM1("Work Phone: "_VAQINF,X,42,37)
- +7 DO TMP
- KILL VAQTMP,VAQINF
- +8 DO BLANK^VAQDIS20
- ROW7 ;
- +1 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.341,0))
- +2 SET VAQINF=$SELECT(VAQTMP="":"UNANSWERED",1:VAQTMP)
- +3 SET X=$$SETSTR^VALM1("Designee: "_VAQINF,"",5,36)
- +4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.342,0))
- +5 SET VAQINF=$SELECT(VAQTMP="":"UNANSWERED",1:VAQTMP)
- +6 SET X=$$SETSTR^VALM1("Relation: "_VAQINF,X,44,37)
- +7 DO TMP
- KILL VAQTMP,VAQINF
- +8 ;
- ROW8 ; -- Address line 1,2,3
- +1 FOR VAQX=.343,.344,.345
- Begin DoDot:1
- +2 SET VAQINF=$GET(@XTRCT@("VALUE",2,VAQX,0))
- +3 if ((VAQX=.343)&(VAQINF=""))
- SET VAQINF="STREET ADDRESS UNKNOWN"
- +4 if (VAQINF="")
- QUIT
- +5 SET X=$$SETSTR^VALM1(VAQINF,"",15,53)
- +6 DO TMP
- End DoDot:1
- +7 KILL VAQTMP,VAQINF,VAQFLAG,VAQX
- +8 ;
- ROW9 ; -- (city,state,zip)
- +1 SET CTY=$GET(@XTRCT@("VALUE",2,.346,0))
- +2 SET ZIP=$GET(@XTRCT@("VALUE",2,.2202,0))
- +3 SET STATE=$$STATE^VAQDIS20($GET(@XTRCT@("VALUE",2,.347,0)))
- +4 SET VAQINF=$SELECT((CTY="")&(STATE="")&(ZIP=""):"CITY/STATE/ZIP UNKNOWN",1:CTY_$SELECT(STATE="":" ",1:", ")_STATE_" "_ZIP)
- +5 SET X=$$SETSTR^VALM1(VAQINF,"",15,53)
- +6 DO TMP
- KILL CTY,STATE,ZIP,VAQINF
- +7 ;
- ROW10 ;
- +1 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.349,0))
- +2 SET VAQINF=$SELECT(VAQTMP="":"UNANSWERED",1:VAQTMP)
- +3 SET X=$$SETSTR^VALM1("Phone: "_VAQINF,"",8,34)
- +4 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.34011,0))
- +5 SET VAQINF=$SELECT(VAQTMP="":"UNANSWERED",1:VAQTMP)
- +6 SET X=$$SETSTR^VALM1("Work Phone: "_VAQINF,X,42,37)
- +7 DO TMP
- KILL VAQTMP,VAQINF
- +8 ;
- EXIT ; -- Sets the number of lines in display
- +1 QUIT
- +2 ;
- ADRLOAD ; -- Loads address into display array
- +1 FOR VAQX=1:1:4
- Begin DoDot:1
- +2 SET VAQINF=""
- +3 if ($DATA(ADDR(VAQX)))
- SET VAQINF=$$SETSTR^VALM1(ADDR(VAQX),VAQINF,15,53)
- +4 if ($DATA(ADDRT(VAQX)))
- SET VAQINF=$$SETSTR^VALM1(ADDRT(VAQX),VAQINF,54,25)
- +5 if (VAQINF="")
- QUIT
- +6 SET VALMCNT=VALMCNT+1
- +7 SET @ROOT@(VALMCNT,0)=$EXTRACT(VAQINF,1,79)
- End DoDot:1
- +8 QUIT
- +9 ;
- TMP ; -- Sets up display array
- +1 SET VALMCNT=VALMCNT+1
- +2 SET @ROOT@(VALMCNT,0)=$EXTRACT(X,1,79)
- +3 QUIT
- +4 ;
- END ; -- End of code
- +1 QUIT