VAQDIS28 ;ALB/JFP - PDX, BUILDS DISPLAY ARRAY FOR MAS DATA ;01MAR93
;;1.5;PATIENT DATA EXCHANGE;**13**;NOV 17, 1993
SCR5 ; -- Builds MAS DATA SCREEN 5, INSURANCE DATA
ROW0 ; -- HEADER
D BLANK^VAQDIS20
S VAQLN=$$REPEAT^VAQUTL1(" ",79)
S VAQCTR=" -- INSURANCE DATA -- "
S X=$$CENTER^VAQDIS20(VAQLN,VAQCTR)
D TMP,BLANK^VAQDIS20
K VAQLN,VAQCTR
ROW1 ;
S VAQTMP=$G(@XTRCT@("VALUE",2,.3192,0))
S VAQINF=$S(VAQTMP'="":VAQTMP,1:"UNANSWERED")
S X=$$SETSTR^VALM1("Covered by Health Insurance: "_VAQINF,"",5,79)
D TMP K VAQTMP,VAQINF
ROW2 ;
S VAQTMP=$G(@XTRCT@("VALUE",2,.381,0))
S VAQINF=$S(VAQTMP'="":VAQTMP,1:"UNANSWERED")
S X=$$SETSTR^VALM1("Eligible for MEDICAID: "_VAQINF,"",5,35)
I VAQINF'="UNANSWERED" D
.S VAQTMP=$G(@XTRCT@("VALUE",2,.382,0)) D SCR6A^VAQDIS29
.S X=$$SETSTR^VALM1("[last updated: "_VAQINF_" ]",X,41,38)
D TMP K VAQTMP,VAQINF
ROW3 ;
D BLANK^VAQDIS20
S X=$$SETSTR^VALM1("Insurance Co.","",2,17)
S X=$$SETSTR^VALM1("Policy #",X,20,20)
S X=$$SETSTR^VALM1("Group",X,41,12)
S X=$$SETSTR^VALM1("Holder",X,53,8)
S X=$$SETSTR^VALM1("Effective",X,61,10)
S X=$$SETSTR^VALM1("Expires",X,71,8)
D TMP
S VAQLN=$$REPEAT^VAQUTL1("=",79)
S X=$$SETSTR^VALM1(VAQLN,"",2,79)
D TMP
S SEQ=""
F J=1:1 S SEQ=$O(@XTRCT@("VALUE",2.312,.01,SEQ)) Q:SEQ="" D
.S X=$$SETSTR^VALM1($G(@XTRCT@("VALUE",2.312,.01,SEQ)),"",2,17)
.S X=$$SETSTR^VALM1($G(@XTRCT@("VALUE",2.312,1,SEQ)),X,20,20)
.S VAQINF=$G(@XTRCT@("VALUE",355.3,.04,SEQ))
.S:(VAQINF="") VAQINF=$G(@XTRCT@("VALUE",355.3,.03,SEQ))
.S X=$$SETSTR^VALM1(VAQINF,X,41,12)
.S X=$$SETSTR^VALM1($G(@XTRCT@("VALUE",2.312,6,SEQ)),X,53,8)
.S VAQTMP=$G(@XTRCT@("VALUE",2.312,8,SEQ)) D SCR6A^VAQDIS29
.S X=$$SETSTR^VALM1(VAQINF,X,61,10)
.S VAQTMP=$G(@XTRCT@("VALUE",2.312,3,SEQ)) D SCR6A^VAQDIS29
.S X=$$SETSTR^VALM1(VAQINF,X,71,8)
.D TMP
I J=1 S X=$$SETSTR^VALM1("No active (unexpired) insurance was on file","",2,79) D TMP
K SEQ,J,VAQTMP,VAQINF,VAQLN
;
EXIT ;
QUIT
;
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[HVAQDIS28 2125 printed Oct 16, 2024@18:26:14 Page 2
VAQDIS28 ;ALB/JFP - PDX, BUILDS DISPLAY ARRAY FOR MAS DATA ;01MAR93
+1 ;;1.5;PATIENT DATA EXCHANGE;**13**;NOV 17, 1993
SCR5 ; -- Builds MAS DATA SCREEN 5, INSURANCE DATA
ROW0 ; -- HEADER
+1 DO BLANK^VAQDIS20
+2 SET VAQLN=$$REPEAT^VAQUTL1(" ",79)
+3 SET VAQCTR=" -- INSURANCE DATA -- "
+4 SET X=$$CENTER^VAQDIS20(VAQLN,VAQCTR)
+5 DO TMP
DO BLANK^VAQDIS20
+6 KILL VAQLN,VAQCTR
ROW1 ;
+1 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.3192,0))
+2 SET VAQINF=$SELECT(VAQTMP'="":VAQTMP,1:"UNANSWERED")
+3 SET X=$$SETSTR^VALM1("Covered by Health Insurance: "_VAQINF,"",5,79)
+4 DO TMP
KILL VAQTMP,VAQINF
ROW2 ;
+1 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.381,0))
+2 SET VAQINF=$SELECT(VAQTMP'="":VAQTMP,1:"UNANSWERED")
+3 SET X=$$SETSTR^VALM1("Eligible for MEDICAID: "_VAQINF,"",5,35)
+4 IF VAQINF'="UNANSWERED"
Begin DoDot:1
+5 SET VAQTMP=$GET(@XTRCT@("VALUE",2,.382,0))
DO SCR6A^VAQDIS29
+6 SET X=$$SETSTR^VALM1("[last updated: "_VAQINF_" ]",X,41,38)
End DoDot:1
+7 DO TMP
KILL VAQTMP,VAQINF
ROW3 ;
+1 DO BLANK^VAQDIS20
+2 SET X=$$SETSTR^VALM1("Insurance Co.","",2,17)
+3 SET X=$$SETSTR^VALM1("Policy #",X,20,20)
+4 SET X=$$SETSTR^VALM1("Group",X,41,12)
+5 SET X=$$SETSTR^VALM1("Holder",X,53,8)
+6 SET X=$$SETSTR^VALM1("Effective",X,61,10)
+7 SET X=$$SETSTR^VALM1("Expires",X,71,8)
+8 DO TMP
+9 SET VAQLN=$$REPEAT^VAQUTL1("=",79)
+10 SET X=$$SETSTR^VALM1(VAQLN,"",2,79)
+11 DO TMP
+12 SET SEQ=""
+13 FOR J=1:1
SET SEQ=$ORDER(@XTRCT@("VALUE",2.312,.01,SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+14 SET X=$$SETSTR^VALM1($GET(@XTRCT@("VALUE",2.312,.01,SEQ)),"",2,17)
+15 SET X=$$SETSTR^VALM1($GET(@XTRCT@("VALUE",2.312,1,SEQ)),X,20,20)
+16 SET VAQINF=$GET(@XTRCT@("VALUE",355.3,.04,SEQ))
+17 if (VAQINF="")
SET VAQINF=$GET(@XTRCT@("VALUE",355.3,.03,SEQ))
+18 SET X=$$SETSTR^VALM1(VAQINF,X,41,12)
+19 SET X=$$SETSTR^VALM1($GET(@XTRCT@("VALUE",2.312,6,SEQ)),X,53,8)
+20 SET VAQTMP=$GET(@XTRCT@("VALUE",2.312,8,SEQ))
DO SCR6A^VAQDIS29
+21 SET X=$$SETSTR^VALM1(VAQINF,X,61,10)
+22 SET VAQTMP=$GET(@XTRCT@("VALUE",2.312,3,SEQ))
DO SCR6A^VAQDIS29
+23 SET X=$$SETSTR^VALM1(VAQINF,X,71,8)
+24 DO TMP
End DoDot:1
+25 IF J=1
SET X=$$SETSTR^VALM1("No active (unexpired) insurance was on file","",2,79)
DO TMP
+26 KILL SEQ,J,VAQTMP,VAQINF,VAQLN
+27 ;
EXIT ;
+1 QUIT
+2 ;
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
