- 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 Mar 13, 2025@21:29:59 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
