- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNBMI.m
r613 r623 1 IBCNBMI ;ALB/ARH-Ins Buffer: move buffer data to insurance files ;09 Mar 2005 11:42 AM 2 ;;2.0;INTEGRATED BILLING;**82,184,246,251,299,345,361,371**;21-MAR-94;Build 57 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 INS(IBBUFDA,IBINSDA,TYPE) ; move buffer insurance company data (file 355.33) to existing Insurance Company (file 36) 6 ; 7 S IBBUFDA=IBBUFDA_",",IBINSDA=$G(IBINSDA)_"," 8 D SET("INS",IBBUFDA,IBINSDA,TYPE) 9 Q 10 ; 11 GRP(IBBUFDA,IBGRPDA,TYPE) ; move buffer insurance group/plan data (file 355.33) to existing Group/Plan (file 355.33) 12 ; 13 S IBBUFDA=IBBUFDA_",",IBGRPDA=$G(IBGRPDA)_"," 14 D SET("GRP",IBBUFDA,IBGRPDA,TYPE) 15 D STUFF("GRP",IBGRPDA) 16 Q 17 ; 18 POLICY(IBBUFDA,IBPOLDA,TYPE) ; move buffer insurance policy data (file 355.33) to existing Patient Policy (file 2.312) 19 ; 20 N DFN S DFN=+$G(^IBA(355.33,+$G(IBBUFDA),60)) Q:'DFN 21 ; 22 S IBBUFDA=IBBUFDA_",",IBPOLDA=$G(IBPOLDA)_","_DFN_"," 23 D SET("POL",IBBUFDA,IBPOLDA,TYPE) 24 D STUFF("POL",IBPOLDA) 25 D POLOTH(IBBUFDA,IBPOLDA) 26 Q 27 ; 28 SET(SET,IBBUFDA,IBEXTDA,TYPE) ; move buffer data to insurance files 29 ; Input: IBBUFDA - ifn of Buffer File entry to move (#355.33) 30 ; IBEXTDA - ifn of insurance entry to update (#36,355.3,2) 31 ; TYPE - 1 = Merge (only buffer data moved to blank fields in ins file, no replace) 32 ; 2 = Overwrite (all buffer data moved to ins file, replace existing data) 33 ; 3 = Replace (all buffer data including null move to ins file) 34 ; 4 = Individually Accept (Skip Blanks) (user accepts 35 ; individual diffs b/w buffer data and existing file data (excl blanks) 36 ; to overwrite flds (or addr grp) in existing file) 37 ; 38 ; 39 N IBX,IBFLDS,EXTFILE,DRBUF,DREXT,BUFARR,EXTARR,IBBUFFLD,IBEXTFLD,IBBUFVAL,IBEXTVAL,IBCHNG,IBCHNGN,IBERR 40 ; 41 D FIELDS(SET_"FLD") 42 S IBX=$P($T(@(SET_"DR")+1),";;",2),EXTFILE=+$P(IBX,U,1),DRBUF=$P(IBX,U,2),DREXT=$P(IBX,U,3) 43 ; 44 D GETS^DIQ(355.33,IBBUFDA,DRBUF,"E","BUFARR") 45 D GETS^DIQ(EXTFILE,IBEXTDA,DREXT,"E","EXTARR") 46 ; 47 I +$G(TYPE) S IBBUFFLD=0 F S IBBUFFLD=$O(BUFARR(355.33,IBBUFDA,IBBUFFLD)) Q:'IBBUFFLD D 48 . S IBEXTFLD=$G(IBFLDS(IBBUFFLD)) Q:'IBEXTFLD 49 . S IBBUFVAL=BUFARR(355.33,IBBUFDA,IBBUFFLD,"E") 50 . S IBEXTVAL=$G(EXTARR(EXTFILE,IBEXTDA,IBEXTFLD,"E")) 51 . ; 52 . I IBBUFVAL=IBEXTVAL Q 53 . I TYPE=1,IBEXTVAL'="" Q 54 . I TYPE=2,IBBUFVAL="" Q 55 . I TYPE=4,'$D(^TMP($J,"IB BUFFER SELECTED",IBBUFFLD)) Q 56 . ; 57 . S IBCHNG(EXTFILE,IBEXTDA,IBEXTFLD)=IBBUFVAL 58 . S IBCHNGN(EXTFILE,IBEXTDA,IBEXTFLD)="" 59 ; 60 I $D(IBCHNGN)>9 D FILE^DIE("E","IBCHNGN","IBERR") 61 I $D(IBCHNG)>9 D FILE^DIE("E","IBCHNG","IBERR") 62 Q 63 ; 64 STUFF(SET,IBEXTDA) ; update fields in insurance files that should be automatically set when an entry is edited 65 ; Input: IBEXTDA - ifn of insurance entry to update (#36,356,2) 66 ; 67 N IBX,IBFLDS,EXTFILE,IBEXTFLD,IBEXTVAL,IBCHNG,IBCHNGN,IBERR 68 ; 69 D FIELDS(SET_"A") 70 S IBX=$P($T(@(SET_"DR")+1),";;",2),EXTFILE=+$P(IBX,U,1) 71 ; 72 S IBEXTFLD=0 F S IBEXTFLD=$O(IBFLDS(IBEXTFLD)) Q:'IBEXTFLD D 73 . S IBEXTVAL=IBFLDS(IBEXTFLD) I IBEXTVAL="DUZ" S IBEXTVAL="`"_DUZ 74 . S IBCHNG(EXTFILE,IBEXTDA,IBEXTFLD)=IBEXTVAL 75 . S IBCHNGN(EXTFILE,IBEXTDA,IBEXTFLD)="" 76 ; 77 D FILE^DIE("E","IBCHNGN","IBERR") 78 D FILE^DIE("E","IBCHNG","IBERR") 79 Q 80 ; 81 FIELDS(SET) ; return array of corresponding fields: IBFLDS(Buffer #)=Ins # 82 N IBI,IBLN,IBB,IBE,IBG K IBFLDS,IBADDS,IBLBLS 83 F IBI=1:1 S IBLN=$P($T(@(SET)+IBI),";;",2) Q:IBLN="" I $E(IBLN,1)'=" " D 84 . S IBB=$P(IBLN,U,1),IBE=$P(IBLN,U,2),IBG=$P(IBLN,U,4) 85 . I IBB'="",IBE'="" D 86 .. S IBFLDS(IBB)=IBE 87 .. I SET["FLD" S IBLBLS(IBB)=$P(IBLN,U,3) I +IBG S IBADDS(IBB)=IBE 88 Q 89 ; 90 INSDR ; 91 ;;36^20.02:20.04;21.01:21.06^.131;.132;.133;.111:.116 92 INSFLD ; corresponding fields: Buffer File (355.33) and Insurance Company file (36) 93 ;;20.02^.131^Phone Number^ ; MM Phone Number 94 ;;20.03^.132^Billing Phone^ ; Billing Phone Number 95 ;;20.04^.133^Pre-Cert Phone^ ; Pre-Certification Phone Number 96 ;;21.01^.111^Street [Line 1]^1 ; MM Street Address [Line 1] 97 ;;21.02^.112^Street [Line 2]^1 ; MM Street Address [Line 2] 98 ;;21.03^.113^Street [Line 3]^1 ; MM Street Address [Line 3] 99 ;;21.04^.114^City^1 ; MM City 100 ;;21.05^.115^State^1 ; MM State 101 ;;21.06^.116^Zip^1 ; MM Zip Code 102 ; 103 GRPDR ; 104 ;;355.3^40.02:40.03;40.1;40.11;40.04:40.09;^.03:.04;6.02;6.03;.05:.09;.12 105 GRPFLD ;corresponding fields: Buffer File (355.33) and Insurance Group Plan file (355.3) 106 ;;40.02^.03^Group Name^ ; Group Name 107 ;;40.03^.04^Group Number^ ; Group Number 108 ;;40.1^6.02^BIN^ ; BIN ;;Daou/EEN 109 ;;40.11^6.03^PCN^ ; PCN ;;Daou/EEN 110 ;;40.04^.05^Require UR^ ; Utilization Review Required 111 ;;40.05^.06^Require Pre-Cert^ ; Pre-Certification Required 112 ;;40.06^.12^Require Amb Cert^ ; Ambulatory Care Certification 113 ;;40.07^.07^Exclude Pre-Cond^ ; Exclude Pre-Existing Conditions 114 ;;40.08^.08^Benefits Assign^ ; Benefits Assignable 115 ;;40.09^.09^Type of Plan^ ; Type of Plan 116 ; 117 GRPA ; auto set fields 118 ;;1.05^NOW^ ; Date Last Edited 119 ;;1.06^DUZ^ ; Last edited By 120 ; 121 POLDR ; 122 ;;2.312^60.02:62.01^8;3;1;6;16;17;3.01;3.05;4.01;4.02;.2;3.12;2.1;2.015;2.11;2.12;2.01:2.08;5.01 123 POLFLD ; corresponding fields: Buffer File (355.33) and Insurance Patient Policy file (2.312) 124 ;;60.02^8^Effective Date^ ; Effective Date 125 ;;60.03^3^Expiration Date^ ; Expiration Date 126 ;;60.04^1^Subscriber Id^ ; Subscriber Id 127 ;;60.05^6^Whose Insurance^ ; Whose Insurance 128 ;;60.06^16^Relationship^ ; Pt. Relationship to Insured 129 ;;60.07^17^Name of Insured^ ; Name of Insured 130 ;;60.08^3.01^Insured's DOB^ ; Insured's DOB 131 ;;60.09^3.05^Insured's SSN^ ; Insured's SSN 132 ;;60.1^4.01^Primary Provider^ ; Primary Care Provider 133 ;;60.11^4.02^Provider Phone^ ; Primary Care Provider Phone 134 ;;60.12^.2^Coor of Benefits^ ; Coordination of Benefits 135 ;;60.13^3.12^Insured's Sex^ ; Insured's Sex 136 ;; 137 ;;61.01^2.1^Emp Sponsored^ ; ESGHP? 138 ;;61.02^2.015^Employer Name^ ; Subscriber's Employer Name 139 ;;61.03^2.11^Emp Status^ ; Employment Status 140 ;;61.04^2.12^Retirement Date^ ; Retirement Date 141 ;;61.05^2.01^Send to Employer^ ; Send Bill to Employer? 142 ;;61.06^2.02^Emp Street Ln 1^1 ; Employer Claims Street Line 1 143 ;;61.07^2.03^Emp Street Ln 2^1 ; Employer Claims Street Line 2 144 ;;61.08^2.04^Emp Street Ln 3^1 ; Employer Claims Street Line 3 145 ;;61.09^2.05^Emp City^1 ; Employer Claims City 146 ;;61.1^2.06^Emp State^1 ; Employer Claims State 147 ;;61.11^2.07^Emp Zip Code^1 ; Employer Claims Zip Code 148 ;;61.12^2.08^Emp Phone^ ; Employer Claims Phone 149 ;;62.01^5.01^Patient Id^ ; Patient Id 150 ; 151 POLA ; auto set fields 152 ;;1.03^NOW^ ; Date Last Verified (default is person that accepts entry) 153 ;;1.04^DUZ^ ; Verified By (default is person that accepts entry) 154 ;;1.05^NOW^ ; Date Last Edited 155 ;;1.06^DUZ^ ; Last Edited By 156 ; 157 ; 158 POLOTH(IBBUFDA,IBPOLDA) ; other special cases that can not be transferred using the generic code above, usually because of dependencies 159 N IB0 S IB0=$G(^IBA(355.33,+IBBUFDA,0)) 160 ; 161 ; --- if buffer entry was verified before the accept step, then add the correct verifier info to the policy 162 I +$P(IB0,U,10) D 163 . S IBCHNG(2.312,IBPOLDA,1.03)=$E($P(IB0,U,10),1,12),IBCHNGN(2.312,IBPOLDA,1.03)="" 164 . S IBCHNG(2.312,IBPOLDA,1.04)=$P(IB0,U,11),IBCHNGN(2.312,IBPOLDA,1.04)="" 165 ; 166 I $D(IBCHNGN)>9 D FILE^DIE("I","IBCHNGN","IBERR") 167 I $D(IBCHNG)>9 D FILE^DIE("I","IBCHNG","IBERR") 168 Q 169 ; 170 PAT(DFN,IBPOLDA) ; Force DOB, SSN & SEX from Patient file (#2) in to Insurance Patient Policy file (2.312) 171 N DA,DR,DIE,DOB,SSN,SEX,IENS,WI 172 S IENS=IBPOLDA_","_DFN_"," 173 S WI=$$GET1^DIQ(2.312,IENS,6,"I") 174 I WI'="v" Q ; Only use when Whose Insurance is 'v' 175 S DOB=$$GET1^DIQ(2,DFN,.03,"I") 176 S SSN=$$GET1^DIQ(2,DFN,.09,"I") 177 S SEX=$$GET1^DIQ(2,DFN,.02,"I") 178 S DIE="^DPT("_DFN_",.312,",DA(1)=DFN,DA=IBPOLDA 179 S DR="3.01///^S X=DOB;3.05///^S X=SSN;3.12///^S X=SEX" 180 D ^DIE 181 Q 1 IBCNBMI ;ALB/ARH-Ins Buffer: move buffer data to insurance files ; 09 Mar 2005 11:42 AM 2 ;;2.0;INTEGRATED BILLING;**82,184,246,251,299,345,361**;21-MAR-94;Build 9 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 INS(IBBUFDA,IBINSDA,TYPE) ; move buffer insurance company data (file 355.33) to existing Insurance Company (file 36) 6 ; 7 S IBBUFDA=IBBUFDA_",",IBINSDA=$G(IBINSDA)_"," 8 D SET("INS",IBBUFDA,IBINSDA,TYPE) 9 Q 10 ; 11 GRP(IBBUFDA,IBGRPDA,TYPE) ; move buffer insurance group/plan data (file 355.33) to existing Group/Plan (file 355.33) 12 ; 13 S IBBUFDA=IBBUFDA_",",IBGRPDA=$G(IBGRPDA)_"," 14 D SET("GRP",IBBUFDA,IBGRPDA,TYPE) 15 D STUFF("GRP",IBGRPDA) 16 Q 17 ; 18 POLICY(IBBUFDA,IBPOLDA,TYPE) ; move buffer insurance policy data (file 355.33) to existing Patient Policy (file 2.312) 19 ; 20 N DFN S DFN=+$G(^IBA(355.33,+$G(IBBUFDA),60)) Q:'DFN 21 ; 22 S IBBUFDA=IBBUFDA_",",IBPOLDA=$G(IBPOLDA)_","_DFN_"," 23 D SET("POL",IBBUFDA,IBPOLDA,TYPE) 24 D STUFF("POL",IBPOLDA) 25 D POLOTH(IBBUFDA,IBPOLDA) 26 Q 27 ; 28 SET(SET,IBBUFDA,IBEXTDA,TYPE) ; move buffer data to insurance files 29 ; Input: IBBUFDA - ifn of Buffer File entry to move (#355.33) 30 ; IBEXTDA - ifn of insurance entry to update (#36,355.3,2) 31 ; TYPE - 1 = Merge (only buffer data moved to blank fields in ins file, no replace) 32 ; 2 = Overwrite (all buffer data moved to ins file, replace existing data) 33 ; 3 = Replace (all buffer data including null move to ins file) 34 ; 4 = Individually Accept (Skip Blanks) (user accepts 35 ; individual diffs b/w buffer data and existing file data (excl blanks) 36 ; to overwrite flds (or addr grp) in existing file) 37 ; 38 ; 39 N IBX,IBFLDS,EXTFILE,DRBUF,DREXT,BUFARR,EXTARR,IBBUFFLD,IBEXTFLD,IBBUFVAL,IBEXTVAL,IBCHNG,IBCHNGN,IBERR 40 ; 41 D FIELDS(SET_"FLD") 42 S IBX=$P($T(@(SET_"DR")+1),";;",2),EXTFILE=+$P(IBX,U,1),DRBUF=$P(IBX,U,2),DREXT=$P(IBX,U,3) 43 ; 44 D GETS^DIQ(355.33,IBBUFDA,DRBUF,"E","BUFARR") 45 D GETS^DIQ(EXTFILE,IBEXTDA,DREXT,"E","EXTARR") 46 ; 47 I +$G(TYPE) S IBBUFFLD=0 F S IBBUFFLD=$O(BUFARR(355.33,IBBUFDA,IBBUFFLD)) Q:'IBBUFFLD D 48 . S IBEXTFLD=$G(IBFLDS(IBBUFFLD)) Q:'IBEXTFLD 49 . S IBBUFVAL=BUFARR(355.33,IBBUFDA,IBBUFFLD,"E") 50 . S IBEXTVAL=$G(EXTARR(EXTFILE,IBEXTDA,IBEXTFLD,"E")) 51 . ; 52 . I IBBUFVAL=IBEXTVAL Q 53 . I TYPE=1,IBEXTVAL'="" Q 54 . I TYPE=2,IBBUFVAL="" Q 55 . I TYPE=4,'$D(^TMP($J,"IB BUFFER SELECTED",IBBUFFLD)) Q 56 . ; 57 . S IBCHNG(EXTFILE,IBEXTDA,IBEXTFLD)=IBBUFVAL 58 . S IBCHNGN(EXTFILE,IBEXTDA,IBEXTFLD)="" 59 ; 60 I $D(IBCHNGN)>9 D FILE^DIE("E","IBCHNGN","IBERR") 61 I $D(IBCHNG)>9 D FILE^DIE("E","IBCHNG","IBERR") 62 Q 63 ; 64 STUFF(SET,IBEXTDA) ; update fields in insurance files that should be automatically set when an entry is edited 65 ; Input: IBEXTDA - ifn of insurance entry to update (#36,356,2) 66 ; 67 N IBX,IBFLDS,EXTFILE,IBEXTFLD,IBEXTVAL,IBCHNG,IBCHNGN,IBERR 68 ; 69 D FIELDS(SET_"A") 70 S IBX=$P($T(@(SET_"DR")+1),";;",2),EXTFILE=+$P(IBX,U,1) 71 ; 72 S IBEXTFLD=0 F S IBEXTFLD=$O(IBFLDS(IBEXTFLD)) Q:'IBEXTFLD D 73 . S IBEXTVAL=IBFLDS(IBEXTFLD) I IBEXTVAL="DUZ" S IBEXTVAL="`"_DUZ 74 . S IBCHNG(EXTFILE,IBEXTDA,IBEXTFLD)=IBEXTVAL 75 . S IBCHNGN(EXTFILE,IBEXTDA,IBEXTFLD)="" 76 ; 77 D FILE^DIE("E","IBCHNGN","IBERR") 78 D FILE^DIE("E","IBCHNG","IBERR") 79 Q 80 ; 81 FIELDS(SET) ; return array of corresponding fields: IBFLDS(Buffer #)=Ins # 82 N IBI,IBLN,IBB,IBE,IBG K IBFLDS,IBADDS,IBLBLS 83 F IBI=1:1 S IBLN=$P($T(@(SET)+IBI),";;",2) Q:IBLN="" I $E(IBLN,1)'=" " D 84 . S IBB=$P(IBLN,U,1),IBE=$P(IBLN,U,2),IBG=$P(IBLN,U,4) 85 . I IBB'="",IBE'="" D 86 .. S IBFLDS(IBB)=IBE 87 .. I SET["FLD" S IBLBLS(IBB)=$P(IBLN,U,3) I +IBG S IBADDS(IBB)=IBE 88 Q 89 ; 90 INSDR ; 91 ;;36^20.02:20.04;21.01:21.06^.131;.132;.133;.111:.116 92 INSFLD ; corresponding fields: Buffer File (355.33) and Insurance Company file (36) 93 ;;20.02^.131^Phone Number^ ; MM Phone Number 94 ;;20.03^.132^Billing Phone^ ; Billing Phone Number 95 ;;20.04^.133^Pre-Cert Phone^ ; Pre-Certification Phone Number 96 ;;21.01^.111^Street [Line 1]^1 ; MM Street Address [Line 1] 97 ;;21.02^.112^Street [Line 2]^1 ; MM Street Address [Line 2] 98 ;;21.03^.113^Street [Line 3]^1 ; MM Street Address [Line 3] 99 ;;21.04^.114^City^1 ; MM City 100 ;;21.05^.115^State^1 ; MM State 101 ;;21.06^.116^Zip^1 ; MM Zip Code 102 ; 103 GRPDR ; 104 ;;355.3^40.02:40.03;40.1;40.11;40.04:40.09;^.03:.04;6.02;6.03;.05:.09;.12 105 GRPFLD ;corresponding fields: Buffer File (355.33) and Insurance Group Plan file (355.3) 106 ;;40.02^.03^Group Name^ ; Group Name 107 ;;40.03^.04^Group Number^ ; Group Number 108 ;;40.1^6.02^BIN^ ; BIN ;;Daou/EEN 109 ;;40.11^6.03^PCN^ ; PCN ;;Daou/EEN 110 ;;40.04^.05^Require UR^ ; Utilization Review Required 111 ;;40.05^.06^Require Pre-Cert^ ; Pre-Certification Required 112 ;;40.06^.12^Require Amb Cert^ ; Ambulatory Care Certification 113 ;;40.07^.07^Exclude Pre-Cond^ ; Exclude Pre-Existing Conditions 114 ;;40.08^.08^Benefits Assign^ ; Benefits Assignable 115 ;;40.09^.09^Type of Plan^ ; Type of Plan 116 ; 117 GRPA ; auto set fields 118 ;;1.05^NOW^ ; Date Last Edited 119 ;;1.06^DUZ^ ; Last edited By 120 ; 121 POLDR ; 122 ;;2.312^60.02:61.12^8;3;1;6;16;17;3.01;3.05;4.01;4.02;.2;3.12;2.1;2.015;2.11;2.12;2.01:2.08 123 POLFLD ; corresponding fields: Buffer File (355.33) and Insurance Patient Policy file (2.312) 124 ;;60.02^8^Effective Date^ ; Effective Date 125 ;;60.03^3^Expiration Date^ ; Expiration Date 126 ;;60.04^1^Subscriber Id^ ; Subscriber Id 127 ;;60.05^6^Whose Insurance^ ; Whose Insurance 128 ;;60.06^16^Relationship^ ; Pt. Relationship to Insured 129 ;;60.07^17^Name of Insured^ ; Name of Insured 130 ;;60.08^3.01^Insured's DOB^ ; Insured's DOB 131 ;;60.09^3.05^Insured's SSN^ ; Insured's SSN 132 ;;60.1^4.01^Primary Provider^ ; Primary Care Provider 133 ;;60.11^4.02^Provider Phone^ ; Primary Care Provider Phone 134 ;;60.12^.2^Coor of Benefits^ ; Coordination of Benefits 135 ;;60.13^3.12^Insured's Sex^ ; Insured's Sex 136 ;; 137 ;;61.01^2.1^Emp Sponsored^ ; ESGHP? 138 ;;61.02^2.015^Employer Name^ ; Subscriber's Employer Name 139 ;;61.03^2.11^Emp Status^ ; Employment Status 140 ;;61.04^2.12^Retirement Date^ ; Retirement Date 141 ;;61.05^2.01^Send to Employer^ ; Send Bill to Employer? 142 ;;61.06^2.02^Emp Street Ln 1^1 ; Employer Claims Street Line 1 143 ;;61.07^2.03^Emp Street Ln 2^1 ; Employer Claims Street Line 2 144 ;;61.08^2.04^Emp Street Ln 3^1 ; Employer Claims Street Line 3 145 ;;61.09^2.05^Emp City^1 ; Employer Claims City 146 ;;61.1^2.06^Emp State^1 ; Employer Claims State 147 ;;61.11^2.07^Emp Zip Code^1 ; Employer Claims Zip Code 148 ;;61.12^2.08^Emp Phone^ ; Employer Claims Phone 149 ; 150 POLA ; auto set fields 151 ;;1.03^NOW^ ; Date Last Verified (default is person that accepts entry) 152 ;;1.04^DUZ^ ; Verified By (default is person that accepts entry) 153 ;;1.05^NOW^ ; Date Last Edited 154 ;;1.06^DUZ^ ; Last Edited By 155 ; 156 ; 157 POLOTH(IBBUFDA,IBPOLDA) ; other special cases that can not be transferred using the generic code above, usually because of dependencies 158 N IB0 S IB0=$G(^IBA(355.33,+IBBUFDA,0)) 159 ; 160 ; --- if buffer entry was verified before the accept step, then add the correct verifier info to the policy 161 I +$P(IB0,U,10) D 162 . S IBCHNG(2.312,IBPOLDA,1.03)=$E($P(IB0,U,10),1,12),IBCHNGN(2.312,IBPOLDA,1.03)="" 163 . S IBCHNG(2.312,IBPOLDA,1.04)=$P(IB0,U,11),IBCHNGN(2.312,IBPOLDA,1.04)="" 164 ; 165 I $D(IBCHNGN)>9 D FILE^DIE("I","IBCHNGN","IBERR") 166 I $D(IBCHNG)>9 D FILE^DIE("I","IBCHNG","IBERR") 167 Q 168 ; 169 PAT(DFN,IBPOLDA) ; Force DOB, SSN & SEX from Patient file (#2) in to Insurance Patient Policy file (2.312) 170 N DA,DR,DIE,DOB,SSN,SEX,IENS,WI 171 S IENS=IBPOLDA_","_DFN_"," 172 S WI=$$GET1^DIQ(2.312,IENS,6,"I") 173 I WI'="v" Q ; Only use when Whose Insurance is 'v' 174 S DOB=$$GET1^DIQ(2,DFN,.03,"I") 175 S SSN=$$GET1^DIQ(2,DFN,.09,"I") 176 S SEX=$$GET1^DIQ(2,DFN,.02,"I") 177 S DIE="^DPT("_DFN_",.312,",DA(1)=DFN,DA=IBPOLDA 178 S DR="3.01///^S X=DOB;3.05///^S X=SSN;3.12///^S X=SEX" 179 D ^DIE 180 Q
Note:
See TracChangeset
for help on using the changeset viewer.
