- VAQDBIP7 ;ALB/JRP - CONTINUATION FOR VAQDBIP4: 3/17/2004
- ;;1.5;PATIENT DATA EXCHANGE;**13,42**;NOV 17, 1993
- INSURE ;INSURANCE EXTRACTION (ALL NON-EXPIRED)
- ; DECLARATIONS DONE IN VAQDBIP4
- ;GET LIST OF FIELDS TO EXTRACT
- S TMP=$T(INSURE+1^VAQDBII1)
- S FLDS(1)=$TR($P(TMP,";",4),",",";")
- S TMP=$T(INSURE+2^VAQDBII1)
- S FLDS(2)=$TR($P(TMP,";",4),",",";")
- S TMP=$T(INSURE+3^VAQDBII1)
- S FLDS(3)=$TR($P(TMP,";",4),",",";")
- ;ENCRYPT PATIENT NAME (ID FOR INSURANCE COMPANY & GROUP PLAN)
- S STRING=$P($$PATINFO^VAQUTL1(DFN),U,1)
- S ENCSTR=STRING
- I $$NCRPFLD^VAQUTL2(2,.01) X ENCRYPT
- S NAME=ENCSTR
- N VAQINS
- ;DETERMINE IF COVERED BY HEALTH INSURANCE & ENCRYPT
- ;S TMP=$$INSUR^IBBAPI(DFN,DT,"R",.VAQINS,"1,2,3,4,5,6,8,10,11,12,13,14,18") ; Get all active (not expired) insurance, reimbursable or not
- S TMP=$$INSUR^IBBAPI(DFN,"","ARB",.VAQINS,"1,2,3,4,5,6,8,10,11,12,13,14,18") ; Get all insurance, expired or not, reimbursable or not
- S STRING=$S(TMP:"YES",1:"NO")
- S ENCSTR=STRING
- I $$NCRPFLD^VAQUTL2(2,.3192) X ENCRYPT
- ;GET SEQUENCE NUMBER & STORE INFO
- S SEQ=$$GETSEQ^VAQDBIP(ARRAY,2,.3192)
- S @ARRAY@("ID",2,.3192,SEQ)=NAME
- S @ARRAY@("VALUE",2,.3192,SEQ)=ENCSTR
- ;EXTRACT DATA
- K ^UTILITY("DIQ1",$J)
- S TMP=0
- F S TMP=$O(VAQINS("IBBAPI","INSUR",TMP)) Q:'TMP D
- .;EXTRACT INSURANCE INFO
- .;Prior to patch *42, we took the info directly from file 2.
- .;Now we get it from the IB API call.
- .;PATIENT (#2) file
- .;INSURANCE TYPE (#2.312) Subfile API field equivalent
- .;------------------------------------------ --------------------
- .;.01 INSURANCE TYPE (ptr to file 36) 1 insurance company name
- .;.18 GROUP PLAN (ptr to file 355.3) --
- .;1 SUBSCRIBER ID 14 subscriber ID
- .;2 *GROUP NUMBER --
- .;3 INSURANCE EXPIRATION DATE 11 expiration date
- .;6 WHOSE INSURANCE (v=vet;s=spouse;o=other)12 subscriber relationship
- .;7 *RENEWAL DATE --
- .;8 EFFECTIVE DATE OF POLICY 10 effective date
- .;16 PT. RELATIONSHIP TO INSURED 12 subscriber relationship
- .;17 NAME OF INSURED 13 subscriber name
- .S ^UTILITY("DIQ1",$J,2.312,TMP,.01,"E")=$P(VAQINS("IBBAPI","INSUR",TMP,1),U,2)
- .S ^UTILITY("DIQ1",$J,2.312,TMP,1,"E")=VAQINS("IBBAPI","INSUR",TMP,14)
- .S ^UTILITY("DIQ1",$J,2.312,TMP,3,"E")=$$FMTE^XLFDT(VAQINS("IBBAPI","INSUR",TMP,11))
- .I VAQINS("IBBAPI","INSUR",TMP,12)[U S ^UTILITY("DIQ1",$J,2.312,TMP,6,"E")=$P(VAQINS("IBBAPI","INSUR",TMP,12),U,2)
- .E S ^UTILITY("DIQ1",$J,2.312,TMP,6,"E")=VAQINS("IBBAPI","INSUR",TMP,12)
- .S ^UTILITY("DIQ1",$J,2.312,TMP,8,"E")=$$FMTE^XLFDT(VAQINS("IBBAPI","INSUR",TMP,10))
- .S ^UTILITY("DIQ1",$J,2.312,TMP,16,"E")=^UTILITY("DIQ1",$J,2.312,TMP,6,"E")
- .S ^UTILITY("DIQ1",$J,2.312,TMP,17,"E")=VAQINS("IBBAPI","INSUR",TMP,13)
- .;EXTRACT INFO ABOUT INSURANCE COMPANY
- .;Prior to patch *42, we took the info directly from file 36.
- .;Now we get it from the IB API call.
- .;INSURANCE COMPANY (#36) file API field equivalent
- .;------------------------------------------ --------------------
- .;.01 NAME 1 insurance company name
- .;.111 STREET ADDRESS [LINE 1] 2 street address
- .;.112 STREET ADDRESS [LINE 2] -
- .;.113 STREET ADDRESS [LINE 3] -
- .;.114 CITY 3 city
- .;.115 STATE 4 state
- .;.316 ZIP 5 zip
- .;.131 PHONE NUMBER 6 phone number
- .S ^UTILITY("DIQ1",$J,36,TMP,.01,"E")=$P(VAQINS("IBBAPI","INSUR",TMP,1),U,2)
- .S ^UTILITY("DIQ1",$J,36,TMP,.111,"E")=VAQINS("IBBAPI","INSUR",TMP,2)
- .S ^UTILITY("DIQ1",$J,36,TMP,.114,"E")=VAQINS("IBBAPI","INSUR",TMP,3)
- .S ^UTILITY("DIQ1",$J,36,TMP,.115,"E")=$P(VAQINS("IBBAPI","INSUR",TMP,4),U,2)
- .S ^UTILITY("DIQ1",$J,36,TMP,.316,"E")=VAQINS("IBBAPI","INSUR",TMP,5)
- .S ^UTILITY("DIQ1",$J,36,TMP,.131,"E")=VAQINS("IBBAPI","INSUR",TMP,6)
- .;EXTRACT INFO ABOUT GROUP PLAN
- .;Prior to patch *42, we took the info directly from file 355.3.
- .;Now we get it from the IB API call.
- .;GROUP INSURANCE PLAN (#355.3) file API field equivalent
- .;------------------------------------------ --------------------
- .;.01 INSURANCE COMPANY (ptr to file 36) 1 insurance company name
- .;.02 IS THIS A GROUP POLICY? (1=yes/0=no) -
- .;.03 GROUP NAME 8 policy IEN and name
- .;.04 GROUP NUMBER 18 policy number
- .;.1 INDIVIDUAL POLICY PATIENT (ptr to file 2)-
- .S ^UTILITY("DIQ1",$J,355.3,TMP,.01,"E")=$P(VAQINS("IBBAPI","INSUR",TMP,1),U,2)
- .S ^UTILITY("DIQ1",$J,355.3,TMP,.03,"E")=$P(VAQINS("IBBAPI","INSUR",TMP,8),U,2)
- .S ^UTILITY("DIQ1",$J,355.3,TMP,.04,"E")=VAQINS("IBBAPI","INSUR",TMP,18)
- .;GET SEQUENCE NUMBER FOR INSURANCE
- .S SEQ=$$GETSEQ^VAQDBIP(ARRAY,2.312,.01)
- .;ENCRYPT COMPANY NAME
- .S STRING=$G(^UTILITY("DIQ1",$J,2.312,TMP,.01,"E"))
- .S ENCSTR=STRING
- .I $$NCRPFLD^VAQUTL2(2.312,.01) X ENCRYPT
- .S PRIME=ENCSTR
- .;STORE COMPANY NAME/ID
- .S @ARRAY@("ID",2.312,.01,SEQ)=NAME
- .S @ARRAY@("VALUE",2.312,.01,SEQ)=PRIME
- .F X=1:1:$L(FLDS(1),";") D
- ..S Z=$P(FLDS(1),";",X)
- ..Q:(Z=.01)
- ..;STORE ID (COMPANY NAME)
- ..S @ARRAY@("ID",2.312,Z,SEQ)=PRIME
- ..;ENCRYPT/STORE VALUE
- ..S STRING=$G(^UTILITY("DIQ1",$J,2.312,TMP,Z,"E"))
- ..S ENCSTR=STRING
- ..I $$NCRPFLD^VAQUTL2(2.312,Z) X ENCRYPT
- ..S @ARRAY@("VALUE",2.312,Z,SEQ)=ENCSTR
- .;GET SEQUENCE NUMBER FOR COMPANY
- .S SEQ=$$GETSEQ^VAQDBIP(ARRAY,36,.01)
- .;ENCRYPT COMPANY NAME
- .S STRING=$G(^UTILITY("DIQ1",$J,36,TMP,.01,"E"))
- .S ENCSTR=STRING
- .I $$NCRPFLD^VAQUTL2(36,.01) X ENCRYPT
- .S PRIME=ENCSTR
- .;STORE COMPANY NAME/ID
- .S @ARRAY@("ID",36,.01,SEQ)=NAME
- .S @ARRAY@("VALUE",36,.01,SEQ)=PRIME
- .F X=1:1:$L(FLDS(2),";") D
- ..S Z=$P(FLDS(2),";",X)
- ..Q:(Z=.01)
- ..;STORE ID (COMPANY NAME)
- ..S @ARRAY@("ID",36,Z,SEQ)=PRIME
- ..;ENCRYPT/STORE VALUE
- ..S STRING=$G(^UTILITY("DIQ1",$J,36,TMP,Z,"E"))
- ..S ENCSTR=STRING
- ..I $$NCRPFLD^VAQUTL2(36,Z) X ENCRYPT
- ..S @ARRAY@("VALUE",36,Z,SEQ)=ENCSTR
- .;GET SEQUENCE NUMBER FOR GROUP PLAN
- .S SEQ=$$GETSEQ^VAQDBIP(ARRAY,355.3,.01)
- .;ENCRYPT PLAN NAME
- .S STRING=$G(^UTILITY("DIQ1",$J,355.3,TMP,.01,"E"))
- .S ENCSTR=STRING
- .I $$NCRPFLD^VAQUTL2(355.3,.01) X ENCRYPT
- .S PRIME=ENCSTR
- .;STORE PLAN NAME/ID
- .S @ARRAY@("ID",355.3,.01,SEQ)=NAME
- .S @ARRAY@("VALUE",355.3,.01,SEQ)=PRIME
- .F X=1:1:$L(FLDS(3),";") D
- ..S Z=$P(FLDS(3),";",X)
- ..Q:(Z=.01)
- ..;STORE ID (PLAN NAME)
- ..S @ARRAY@("ID",355.3,Z,SEQ)=PRIME
- ..;ENCRYPT/STORE VALUE
- ..S STRING=$G(^UTILITY("DIQ1",$J,355.3,TMP,Z,"E"))
- ..S ENCSTR=STRING
- ..I $$NCRPFLD^VAQUTL2(355.3,Z) X ENCRYPT
- ..S @ARRAY@("VALUE",355.3,Z,SEQ)=ENCSTR
- .K ^UTILITY("DIQ1",$J)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQDBIP7 6922 printed Mar 13, 2025@21:29:43 Page 2
- VAQDBIP7 ;ALB/JRP - CONTINUATION FOR VAQDBIP4: 3/17/2004
- +1 ;;1.5;PATIENT DATA EXCHANGE;**13,42**;NOV 17, 1993
- INSURE ;INSURANCE EXTRACTION (ALL NON-EXPIRED)
- +1 ; DECLARATIONS DONE IN VAQDBIP4
- +2 ;GET LIST OF FIELDS TO EXTRACT
- +3 SET TMP=$TEXT(INSURE+1^VAQDBII1)
- +4 SET FLDS(1)=$TRANSLATE($PIECE(TMP,";",4),",",";")
- +5 SET TMP=$TEXT(INSURE+2^VAQDBII1)
- +6 SET FLDS(2)=$TRANSLATE($PIECE(TMP,";",4),",",";")
- +7 SET TMP=$TEXT(INSURE+3^VAQDBII1)
- +8 SET FLDS(3)=$TRANSLATE($PIECE(TMP,";",4),",",";")
- +9 ;ENCRYPT PATIENT NAME (ID FOR INSURANCE COMPANY & GROUP PLAN)
- +10 SET STRING=$PIECE($$PATINFO^VAQUTL1(DFN),U,1)
- +11 SET ENCSTR=STRING
- +12 IF $$NCRPFLD^VAQUTL2(2,.01)
- XECUTE ENCRYPT
- +13 SET NAME=ENCSTR
- +14 NEW VAQINS
- +15 ;DETERMINE IF COVERED BY HEALTH INSURANCE & ENCRYPT
- +16 ;S TMP=$$INSUR^IBBAPI(DFN,DT,"R",.VAQINS,"1,2,3,4,5,6,8,10,11,12,13,14,18") ; Get all active (not expired) insurance, reimbursable or not
- +17 ; Get all insurance, expired or not, reimbursable or not
- SET TMP=$$INSUR^IBBAPI(DFN,"","ARB",.VAQINS,"1,2,3,4,5,6,8,10,11,12,13,14,18")
- +18 SET STRING=$SELECT(TMP:"YES",1:"NO")
- +19 SET ENCSTR=STRING
- +20 IF $$NCRPFLD^VAQUTL2(2,.3192)
- XECUTE ENCRYPT
- +21 ;GET SEQUENCE NUMBER & STORE INFO
- +22 SET SEQ=$$GETSEQ^VAQDBIP(ARRAY,2,.3192)
- +23 SET @ARRAY@("ID",2,.3192,SEQ)=NAME
- +24 SET @ARRAY@("VALUE",2,.3192,SEQ)=ENCSTR
- +25 ;EXTRACT DATA
- +26 KILL ^UTILITY("DIQ1",$JOB)
- +27 SET TMP=0
- +28 FOR
- SET TMP=$ORDER(VAQINS("IBBAPI","INSUR",TMP))
- if 'TMP
- QUIT
- Begin DoDot:1
- +29 ;EXTRACT INSURANCE INFO
- +30 ;Prior to patch *42, we took the info directly from file 2.
- +31 ;Now we get it from the IB API call.
- +32 ;PATIENT (#2) file
- +33 ;INSURANCE TYPE (#2.312) Subfile API field equivalent
- +34 ;------------------------------------------ --------------------
- +35 ;.01 INSURANCE TYPE (ptr to file 36) 1 insurance company name
- +36 ;.18 GROUP PLAN (ptr to file 355.3) --
- +37 ;1 SUBSCRIBER ID 14 subscriber ID
- +38 ;2 *GROUP NUMBER --
- +39 ;3 INSURANCE EXPIRATION DATE 11 expiration date
- +40 ;6 WHOSE INSURANCE (v=vet;s=spouse;o=other)12 subscriber relationship
- +41 ;7 *RENEWAL DATE --
- +42 ;8 EFFECTIVE DATE OF POLICY 10 effective date
- +43 ;16 PT. RELATIONSHIP TO INSURED 12 subscriber relationship
- +44 ;17 NAME OF INSURED 13 subscriber name
- +45 SET ^UTILITY("DIQ1",$JOB,2.312,TMP,.01,"E")=$PIECE(VAQINS("IBBAPI","INSUR",TMP,1),U,2)
- +46 SET ^UTILITY("DIQ1",$JOB,2.312,TMP,1,"E")=VAQINS("IBBAPI","INSUR",TMP,14)
- +47 SET ^UTILITY("DIQ1",$JOB,2.312,TMP,3,"E")=$$FMTE^XLFDT(VAQINS("IBBAPI","INSUR",TMP,11))
- +48 IF VAQINS("IBBAPI","INSUR",TMP,12)[U
- SET ^UTILITY("DIQ1",$JOB,2.312,TMP,6,"E")=$PIECE(VAQINS("IBBAPI","INSUR",TMP,12),U,2)
- +49 IF '$TEST
- SET ^UTILITY("DIQ1",$JOB,2.312,TMP,6,"E")=VAQINS("IBBAPI","INSUR",TMP,12)
- +50 SET ^UTILITY("DIQ1",$JOB,2.312,TMP,8,"E")=$$FMTE^XLFDT(VAQINS("IBBAPI","INSUR",TMP,10))
- +51 SET ^UTILITY("DIQ1",$JOB,2.312,TMP,16,"E")=^UTILITY("DIQ1",$JOB,2.312,TMP,6,"E")
- +52 SET ^UTILITY("DIQ1",$JOB,2.312,TMP,17,"E")=VAQINS("IBBAPI","INSUR",TMP,13)
- +53 ;EXTRACT INFO ABOUT INSURANCE COMPANY
- +54 ;Prior to patch *42, we took the info directly from file 36.
- +55 ;Now we get it from the IB API call.
- +56 ;INSURANCE COMPANY (#36) file API field equivalent
- +57 ;------------------------------------------ --------------------
- +58 ;.01 NAME 1 insurance company name
- +59 ;.111 STREET ADDRESS [LINE 1] 2 street address
- +60 ;.112 STREET ADDRESS [LINE 2] -
- +61 ;.113 STREET ADDRESS [LINE 3] -
- +62 ;.114 CITY 3 city
- +63 ;.115 STATE 4 state
- +64 ;.316 ZIP 5 zip
- +65 ;.131 PHONE NUMBER 6 phone number
- +66 SET ^UTILITY("DIQ1",$JOB,36,TMP,.01,"E")=$PIECE(VAQINS("IBBAPI","INSUR",TMP,1),U,2)
- +67 SET ^UTILITY("DIQ1",$JOB,36,TMP,.111,"E")=VAQINS("IBBAPI","INSUR",TMP,2)
- +68 SET ^UTILITY("DIQ1",$JOB,36,TMP,.114,"E")=VAQINS("IBBAPI","INSUR",TMP,3)
- +69 SET ^UTILITY("DIQ1",$JOB,36,TMP,.115,"E")=$PIECE(VAQINS("IBBAPI","INSUR",TMP,4),U,2)
- +70 SET ^UTILITY("DIQ1",$JOB,36,TMP,.316,"E")=VAQINS("IBBAPI","INSUR",TMP,5)
- +71 SET ^UTILITY("DIQ1",$JOB,36,TMP,.131,"E")=VAQINS("IBBAPI","INSUR",TMP,6)
- +72 ;EXTRACT INFO ABOUT GROUP PLAN
- +73 ;Prior to patch *42, we took the info directly from file 355.3.
- +74 ;Now we get it from the IB API call.
- +75 ;GROUP INSURANCE PLAN (#355.3) file API field equivalent
- +76 ;------------------------------------------ --------------------
- +77 ;.01 INSURANCE COMPANY (ptr to file 36) 1 insurance company name
- +78 ;.02 IS THIS A GROUP POLICY? (1=yes/0=no) -
- +79 ;.03 GROUP NAME 8 policy IEN and name
- +80 ;.04 GROUP NUMBER 18 policy number
- +81 ;.1 INDIVIDUAL POLICY PATIENT (ptr to file 2)-
- +82 SET ^UTILITY("DIQ1",$JOB,355.3,TMP,.01,"E")=$PIECE(VAQINS("IBBAPI","INSUR",TMP,1),U,2)
- +83 SET ^UTILITY("DIQ1",$JOB,355.3,TMP,.03,"E")=$PIECE(VAQINS("IBBAPI","INSUR",TMP,8),U,2)
- +84 SET ^UTILITY("DIQ1",$JOB,355.3,TMP,.04,"E")=VAQINS("IBBAPI","INSUR",TMP,18)
- +85 ;GET SEQUENCE NUMBER FOR INSURANCE
- +86 SET SEQ=$$GETSEQ^VAQDBIP(ARRAY,2.312,.01)
- +87 ;ENCRYPT COMPANY NAME
- +88 SET STRING=$GET(^UTILITY("DIQ1",$JOB,2.312,TMP,.01,"E"))
- +89 SET ENCSTR=STRING
- +90 IF $$NCRPFLD^VAQUTL2(2.312,.01)
- XECUTE ENCRYPT
- +91 SET PRIME=ENCSTR
- +92 ;STORE COMPANY NAME/ID
- +93 SET @ARRAY@("ID",2.312,.01,SEQ)=NAME
- +94 SET @ARRAY@("VALUE",2.312,.01,SEQ)=PRIME
- +95 FOR X=1:1:$LENGTH(FLDS(1),";")
- Begin DoDot:2
- +96 SET Z=$PIECE(FLDS(1),";",X)
- +97 if (Z=.01)
- QUIT
- +98 ;STORE ID (COMPANY NAME)
- +99 SET @ARRAY@("ID",2.312,Z,SEQ)=PRIME
- +100 ;ENCRYPT/STORE VALUE
- +101 SET STRING=$GET(^UTILITY("DIQ1",$JOB,2.312,TMP,Z,"E"))
- +102 SET ENCSTR=STRING
- +103 IF $$NCRPFLD^VAQUTL2(2.312,Z)
- XECUTE ENCRYPT
- +104 SET @ARRAY@("VALUE",2.312,Z,SEQ)=ENCSTR
- End DoDot:2
- +105 ;GET SEQUENCE NUMBER FOR COMPANY
- +106 SET SEQ=$$GETSEQ^VAQDBIP(ARRAY,36,.01)
- +107 ;ENCRYPT COMPANY NAME
- +108 SET STRING=$GET(^UTILITY("DIQ1",$JOB,36,TMP,.01,"E"))
- +109 SET ENCSTR=STRING
- +110 IF $$NCRPFLD^VAQUTL2(36,.01)
- XECUTE ENCRYPT
- +111 SET PRIME=ENCSTR
- +112 ;STORE COMPANY NAME/ID
- +113 SET @ARRAY@("ID",36,.01,SEQ)=NAME
- +114 SET @ARRAY@("VALUE",36,.01,SEQ)=PRIME
- +115 FOR X=1:1:$LENGTH(FLDS(2),";")
- Begin DoDot:2
- +116 SET Z=$PIECE(FLDS(2),";",X)
- +117 if (Z=.01)
- QUIT
- +118 ;STORE ID (COMPANY NAME)
- +119 SET @ARRAY@("ID",36,Z,SEQ)=PRIME
- +120 ;ENCRYPT/STORE VALUE
- +121 SET STRING=$GET(^UTILITY("DIQ1",$JOB,36,TMP,Z,"E"))
- +122 SET ENCSTR=STRING
- +123 IF $$NCRPFLD^VAQUTL2(36,Z)
- XECUTE ENCRYPT
- +124 SET @ARRAY@("VALUE",36,Z,SEQ)=ENCSTR
- End DoDot:2
- +125 ;GET SEQUENCE NUMBER FOR GROUP PLAN
- +126 SET SEQ=$$GETSEQ^VAQDBIP(ARRAY,355.3,.01)
- +127 ;ENCRYPT PLAN NAME
- +128 SET STRING=$GET(^UTILITY("DIQ1",$JOB,355.3,TMP,.01,"E"))
- +129 SET ENCSTR=STRING
- +130 IF $$NCRPFLD^VAQUTL2(355.3,.01)
- XECUTE ENCRYPT
- +131 SET PRIME=ENCSTR
- +132 ;STORE PLAN NAME/ID
- +133 SET @ARRAY@("ID",355.3,.01,SEQ)=NAME
- +134 SET @ARRAY@("VALUE",355.3,.01,SEQ)=PRIME
- +135 FOR X=1:1:$LENGTH(FLDS(3),";")
- Begin DoDot:2
- +136 SET Z=$PIECE(FLDS(3),";",X)
- +137 if (Z=.01)
- QUIT
- +138 ;STORE ID (PLAN NAME)
- +139 SET @ARRAY@("ID",355.3,Z,SEQ)=PRIME
- +140 ;ENCRYPT/STORE VALUE
- +141 SET STRING=$GET(^UTILITY("DIQ1",$JOB,355.3,TMP,Z,"E"))
- +142 SET ENCSTR=STRING
- +143 IF $$NCRPFLD^VAQUTL2(355.3,Z)
- XECUTE ENCRYPT
- +144 SET @ARRAY@("VALUE",355.3,Z,SEQ)=ENCSTR
- End DoDot:2
- +145 KILL ^UTILITY("DIQ1",$JOB)
- End DoDot:1
- +146 QUIT
