Routine: IB20P207

IB20P207 ;BP/TJH; ENVIRONMENT CHECK WITH PRE-INIT CODE ; 01/03/2003

 ;;2.0;INTEGRATED BILLING;**207**;21-MAR-94

ENV ; environment check

 ; No special environment check at this time.

PRE ; set up check points for pre-init

N %

 S %=$$NEWCP^XPDUTL("R28","R28^IB20P207")

 S %=$$NEWCP^XPDUTL("R900","R900^IB20P207")

R28 ; set new value into record 28 of file 364.7, re: WAS-0902-20562

 ; change the Format Code

 D BMES^XPDUTL("Updating format code for Admit Date.")

 N IBWPA,IBERRM,DA,DR,DIE,FILE,IENS,FIELD,FLAGS

 S DA=28,DR="1////"_$P($T(TEXT1),";",3),DIE="^IBA(364.7," D ^DIE

 ; change the Format Code Description

 D BMES^XPDUTL("Updating format code description for Admit Date.")

 S IBWPA(1)="Extract only date from date/time retrieved from IBXSAVE array previously"

 S IBWPA(2)="extracted.  For an outpatient claim not related to an inpatient episode,"

 S IBWPA(3)="output the statement 'To Date'.  Format date in CCYYMMDD format."

 S IBWPA(4)="If data element's value is null, do not output."

 S FILE=364.7,IENS="28,",FIELD=3,FLAGS=""

 D WP^DIE(FILE,IENS,FIELD,FLAGS,"IBWPA","IBERRM")

 D COMPLETE

R900 ; set new values into record 900 of file 364.7, re: CTX-1002-70456

 ; change the Data Element from 234 to 236

 D BMES^XPDUTL("For IEN 900, file 364.7: changing data element from")

 D MES^XPDUTL("N-OTHER INSURANCE CO TYPES to N-OTH INS POL TYPES.")

 N IBELE,IBWPA,IBERRM,DA,DR,DIE,FILE,IENS,FIELD,FLAGS

 S IBELE=+$O(^IBA(364.5,"B","N-OTH INS POL TYPES",0))

 S:'IBELE IBELE=236

 S DA=900,DR=".03////"_IBELE,DIE="^IBA(364.7," D ^DIE

 ; change the Format Code

 D BMES^XPDUTL("Updating format code for N-OTH INS POL TYPES.")

 S DA=900,DR="1////"_$P($T(TEXT2),";",3),DIE="^IBA(364.7," D ^DIE

 ; change the Format Code Description

 D BMES^XPDUTL("Updating format code description for N-OTH INS POL TYPES.")

 S IBWPA(1)="If any 'other' insurance company data is found, the data is formatted"

 S IBWPA(2)="from the electronic type of plan of the insurance company policy in X12"

 S IBWPA(3)="format.  Refer to the 837 V4010 (professional) field 2330/REF(3)/01"

 S IBWPA(4)="for details."

 S FILE=364.7,IENS="900,",FIELD=3,FLAGS=""

 D WP^DIE(FILE,IENS,FIELD,FLAGS,"IBWPA","IBERRM")

 D COMPLETE

COMPLETE ; display message that step has completed successfully

 D BMES^XPDUTL("Step complete.")

END ; display message that pre-init has completed successfully

 D BMES^XPDUTL("Pre-init complete")

TEXT ;Storage area for long strings of text

TEXT1 ;;S IBXDATA=$G(IBXSAVE("DISDT")) D:$S(IBXDATA="":'$$INPAT^IBCEF(IBXIEN,1),1:0) F^IBCEF("N-STATEMENT COVERS TO DATE",,,IBXIEN) I IBXDATA S IBXDATA=$$DT^IBCEFG1(IBXDATA\1,"","D8")

TEXT2 ;;N A,Z,Q S Q=IBXDATA K IBXDATA F Z=1,2 S A=$P(Q,U,Z) I $D(^DGCR(399,IBXIEN,"I"_(Z+1))) S IBXDATA(Z)=$S(A="":"G2","MAMB16"[A:"1C",A="TV"!(A="MC"):"1D",A="CH":"1H",A="BL":$S($$FT^IBCEF(IBXIEN)=2:"1B",1:"1A"),1:"G2")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P207   2926     printed  Mar 13, 2025@21:06:36                                                                                                                                                                                                    Page 2

IB20P207  ;BP/TJH; ENVIRONMENT CHECK WITH PRE-INIT CODE ; 01/03/2003

 +1       ;;2.0;INTEGRATED BILLING;**207**;21-MAR-94

 +2       ;

ENV       ; environment check

 +1       ; No special environment check at this time.

PRE       ; set up check points for pre-init

 +1        NEW %

 +2        SET %=$$NEWCP^XPDUTL("R28","R28^IB20P207")

 +3        SET %=$$NEWCP^XPDUTL("R900","R900^IB20P207")

 +4        QUIT

 +5       ;

R28       ; set new value into record 28 of file 364.7, re: WAS-0902-20562

 +1       ; change the Format Code

 +2        DO BMES^XPDUTL("Updating format code for Admit Date.")

 +3        NEW IBWPA,IBERRM,DA,DR,DIE,FILE,IENS,FIELD,FLAGS

 +4        SET DA=28

           SET DR="1////"_$PIECE($TEXT(TEXT1),";",3)

           SET DIE="^IBA(364.7,"

           DO ^DIE

 +5       ; change the Format Code Description

 +6        DO BMES^XPDUTL("Updating format code description for Admit Date.")

 +7        SET IBWPA(1)="Extract only date from date/time retrieved from IBXSAVE array previously"

 +8        SET IBWPA(2)="extracted.  For an outpatient claim not related to an inpatient episode,"

 +9        SET IBWPA(3)="output the statement 'To Date'.  Format date in CCYYMMDD format."

 +10       SET IBWPA(4)="If data element's value is null, do not output."

 +11       SET FILE=364.7

           SET IENS="28,"

           SET FIELD=3

           SET FLAGS=""

 +12       DO WP^DIE(FILE,IENS,FIELD,FLAGS,"IBWPA","IBERRM")

 +13       DO COMPLETE

 +14       QUIT

 +15      ;

R900      ; set new values into record 900 of file 364.7, re: CTX-1002-70456

 +1       ; change the Data Element from 234 to 236

 +2        DO BMES^XPDUTL("For IEN 900, file 364.7: changing data element from")

 +3        DO MES^XPDUTL("N-OTHER INSURANCE CO TYPES to N-OTH INS POL TYPES.")

 +4        NEW IBELE,IBWPA,IBERRM,DA,DR,DIE,FILE,IENS,FIELD,FLAGS

 +5        SET IBELE=+$ORDER(^IBA(364.5,"B","N-OTH INS POL TYPES",0))

 +6        if 'IBELE

               SET IBELE=236

 +7        SET DA=900

           SET DR=".03////"_IBELE

           SET DIE="^IBA(364.7,"

           DO ^DIE

 +8       ; change the Format Code

 +9        DO BMES^XPDUTL("Updating format code for N-OTH INS POL TYPES.")

 +10       SET DA=900

           SET DR="1////"_$PIECE($TEXT(TEXT2),";",3)

           SET DIE="^IBA(364.7,"

           DO ^DIE

 +11      ; change the Format Code Description

 +12       DO BMES^XPDUTL("Updating format code description for N-OTH INS POL TYPES.")

 +13       SET IBWPA(1)="If any 'other' insurance company data is found, the data is formatted"

 +14       SET IBWPA(2)="from the electronic type of plan of the insurance company policy in X12"

 +15       SET IBWPA(3)="format.  Refer to the 837 V4010 (professional) field 2330/REF(3)/01"

 +16       SET IBWPA(4)="for details."

 +17       SET FILE=364.7

           SET IENS="900,"

           SET FIELD=3

           SET FLAGS=""

 +18       DO WP^DIE(FILE,IENS,FIELD,FLAGS,"IBWPA","IBERRM")

 +19       DO COMPLETE

 +20       QUIT

 +21      ;

COMPLETE  ; display message that step has completed successfully

 +1        DO BMES^XPDUTL("Step complete.")

 +2        QUIT

 +3       ;

END       ; display message that pre-init has completed successfully

 +1        DO BMES^XPDUTL("Pre-init complete")

 +2        QUIT

 +3       ;

TEXT      ;Storage area for long strings of text

TEXT1     ;;S IBXDATA=$G(IBXSAVE("DISDT")) D:$S(IBXDATA="":'$$INPAT^IBCEF(IBXIEN,1),1:0) F^IBCEF("N-STATEMENT COVERS TO DATE",,,IBXIEN) I IBXDATA S IBXDATA=$$DT^IBCEFG1(IBXDATA\1,"","D8")

TEXT2     ;;N A,Z,Q S Q=IBXDATA K IBXDATA F Z=1,2 S A=$P(Q,U,Z) I $D(^DGCR(399,IBXIEN,"I"_(Z+1))) S IBXDATA(Z)=$S(A="":"G2","MAMB16"[A:"1C",A="TV"!(A="MC"):"1D",A="CH":"1H",A="BL":$S($$FT^IBCEF(IBXIEN)=2:"1B",1:"1A"),1:"G2")

IB20P207.m