- IBJPS ;ALB/MAF,ARH - IBSP IB SITE PARAMETER SCREEN ;22-DEC-1995
- ;;2.0;INTEGRATED BILLING;**39,52,70,115,143,51,137,161,155,320,348,349,377,384,400,432,494,461,516,547,592,608,623**;21-MAR-94;Build 70
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- EN ; -- main entry point for IBJP IB SITE PARAMETERS, display IB site parameters
- D EN^VALM("IBJP IB SITE PARAMETERS")
- Q
- ;
- HDR ; -- header code
- S VALMHDR(1)="Only authorized persons may edit this data."
- Q
- ;
- INIT ; -- init variables and list array
- K ^TMP("IBJPS",$J),^TMP("IBJPSAX",$J)
- D BLD^IBJPS1
- Q
- ;
- HELP ; -- help code
- S X="?" D DISP^XQORM1 W !!
- Q
- ;
- EXIT ; -- exit code
- K ^TMP("IBJPS",$J),^TMP("IBJPSAX",$J)
- D CLEAR^VALM1
- Q
- ;
- NXEDIT ; -- IBJP IB SITE PARAMETER EDIT ACTION (EP): Select data set to edit, do edit
- N VALMY,IBSELN,IBSET
- D EN^VALM2($G(XQORNOD(0)))
- I $D(VALMY) S IBSELN=0 F S IBSELN=$O(VALMY(IBSELN)) Q:'IBSELN D
- . S IBSET=$P($G(^TMP("IBJPSAX",$J,IBSELN)),U,1) Q:'IBSET
- . D EDIT(IBSET)
- S VALMBCK="R"
- Q
- ;
- EDIT(IBSET) ; edit IB Site Parameters
- D FULL^VALM1
- N DR
- I IBSET'="" D
- . ; MRD;IB*2.0*516 - Added TRICARE Pay-To Providers.
- . ; WCJ;IB*2.0*547 - shifted the numbers down to insert a new one
- . I IBSET=8 D EN^IBJPS5 Q
- . I IBSET=11 D EN^IBJPS3(0) Q
- . I IBSET=12 D EN^IBJPS3(1) Q
- . ;WCJ;IB*2.0*547 added default Administrative contractors for billing (medicare and commercial)
- . I IBSET=17 D EN^IBJPS6(1) Q ; medicare
- . I IBSET=18 D EN^IBJPS6(2) Q ; commercial
- . I IBSET=21 D EN^IBJPS8 Q ; WCJ;IB*2.0*608;US3;
- . S DR=$P($T(@IBSET),";;",2,999)
- . Q
- ; WCJ;IB*2.0*547 - shifted the number down to insert a new one
- I IBSET=9,$$ICD9SYS^IBACSV(DT)=30 S $P(DR,";",1)=7.05
- ;
- I $G(DR)'="" S DIE="^IBE(350.9,",DA=1 D ^DIE K DA,DR,DIE,DIC,X,Y
- ;JWS;IB*2.0*623;If 837 FHIR transaction is turned off, then reset 364 field .09 AC index
- I '$$GET1^DIQ(350.9,"1,",8.21,"I") D
- . S DA=""
- . F S DA=$O(^IBA(364,"AC",1,DA)) Q:DA="" D
- .. S DR=".09////0",DIE="^IBA(364," D ^DIE
- .. Q
- . K DA,DR,DIE,DIC,X
- . Q
- ;JWS;IB*2.0*623;end
- D INIT^IBJPS S VALMBCK="R"
- Q
- ;
- ;WCJ;IB*2.0*547 - cleared the spot for the new #8, added 17 & 18, move 16 to 19.
- ;gef;IB*2.0*547 - added 20
- ;JWS;IB*2.0*592 - added field 8.2 to 16
- ;JWS;IB*2.0*623 - added field 8.21 to 16
- 1 ;;.09;.13;.14
- 2 ;;1.2;.15;.11;.12;7.04
- 3 ;;1.09;1.07;2.07
- 4 ;;4.04;6.25;6.24
- 5 ;;.02;1.14;1.25;1.08
- 6 ;;1.23;1.16;1.22;1.19;1.15;1.17
- 7 ;;1.33;1.32;1.31;1.27;8.14T;8.15T;8.16T;8.19T
- 9 ;;1.29;1.3;1.18;1.28
- 10 ;;1.01;1.02;1.05
- 13 ;;2.08;2.09
- 14 ;;11.01
- 15 ;;10.02;10.03;10.04;10.05;D INIT^IBATFILE
- 16 ;;2.11;8.01;8.09;8.03;8.06;8.04;8.07;8.02;8.12T;8.11T;8.17T;8.2T;8.21T
- 19 ;;50.01;50.02;50.05;50.06;50.03;50.04;50.07
- 20 ;;52.01;52.02
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJPS 2794 printed Feb 18, 2025@23:49:59 Page 2
- IBJPS ;ALB/MAF,ARH - IBSP IB SITE PARAMETER SCREEN ;22-DEC-1995
- +1 ;;2.0;INTEGRATED BILLING;**39,52,70,115,143,51,137,161,155,320,348,349,377,384,400,432,494,461,516,547,592,608,623**;21-MAR-94;Build 70
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- EN ; -- main entry point for IBJP IB SITE PARAMETERS, display IB site parameters
- +1 DO EN^VALM("IBJP IB SITE PARAMETERS")
- +2 QUIT
- +3 ;
- HDR ; -- header code
- +1 SET VALMHDR(1)="Only authorized persons may edit this data."
- +2 QUIT
- +3 ;
- INIT ; -- init variables and list array
- +1 KILL ^TMP("IBJPS",$JOB),^TMP("IBJPSAX",$JOB)
- +2 DO BLD^IBJPS1
- +3 QUIT
- +4 ;
- HELP ; -- help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
- +3 ;
- EXIT ; -- exit code
- +1 KILL ^TMP("IBJPS",$JOB),^TMP("IBJPSAX",$JOB)
- +2 DO CLEAR^VALM1
- +3 QUIT
- +4 ;
- NXEDIT ; -- IBJP IB SITE PARAMETER EDIT ACTION (EP): Select data set to edit, do edit
- +1 NEW VALMY,IBSELN,IBSET
- +2 DO EN^VALM2($GET(XQORNOD(0)))
- +3 IF $DATA(VALMY)
- SET IBSELN=0
- FOR
- SET IBSELN=$ORDER(VALMY(IBSELN))
- if 'IBSELN
- QUIT
- Begin DoDot:1
- +4 SET IBSET=$PIECE($GET(^TMP("IBJPSAX",$JOB,IBSELN)),U,1)
- if 'IBSET
- QUIT
- +5 DO EDIT(IBSET)
- End DoDot:1
- +6 SET VALMBCK="R"
- +7 QUIT
- +8 ;
- EDIT(IBSET) ; edit IB Site Parameters
- +1 DO FULL^VALM1
- +2 NEW DR
- +3 IF IBSET'=""
- Begin DoDot:1
- +4 ; MRD;IB*2.0*516 - Added TRICARE Pay-To Providers.
- +5 ; WCJ;IB*2.0*547 - shifted the numbers down to insert a new one
- +6 IF IBSET=8
- DO EN^IBJPS5
- QUIT
- +7 IF IBSET=11
- DO EN^IBJPS3(0)
- QUIT
- +8 IF IBSET=12
- DO EN^IBJPS3(1)
- QUIT
- +9 ;WCJ;IB*2.0*547 added default Administrative contractors for billing (medicare and commercial)
- +10 ; medicare
- IF IBSET=17
- DO EN^IBJPS6(1)
- QUIT
- +11 ; commercial
- IF IBSET=18
- DO EN^IBJPS6(2)
- QUIT
- +12 ; WCJ;IB*2.0*608;US3;
- IF IBSET=21
- DO EN^IBJPS8
- QUIT
- +13 SET DR=$PIECE($TEXT(@IBSET),";;",2,999)
- +14 QUIT
- End DoDot:1
- +15 ; WCJ;IB*2.0*547 - shifted the number down to insert a new one
- +16 IF IBSET=9
- IF $$ICD9SYS^IBACSV(DT)=30
- SET $PIECE(DR,";",1)=7.05
- +17 ;
- +18 IF $GET(DR)'=""
- SET DIE="^IBE(350.9,"
- SET DA=1
- DO ^DIE
- KILL DA,DR,DIE,DIC,X,Y
- +19 ;JWS;IB*2.0*623;If 837 FHIR transaction is turned off, then reset 364 field .09 AC index
- +20 IF '$$GET1^DIQ(350.9,"1,",8.21,"I")
- Begin DoDot:1
- +21 SET DA=""
- +22 FOR
- SET DA=$ORDER(^IBA(364,"AC",1,DA))
- if DA=""
- QUIT
- Begin DoDot:2
- +23 SET DR=".09////0"
- SET DIE="^IBA(364,"
- DO ^DIE
- +24 QUIT
- End DoDot:2
- +25 KILL DA,DR,DIE,DIC,X
- +26 QUIT
- End DoDot:1
- +27 ;JWS;IB*2.0*623;end
- +28 DO INIT^IBJPS
- SET VALMBCK="R"
- +29 QUIT
- +30 ;
- +31 ;WCJ;IB*2.0*547 - cleared the spot for the new #8, added 17 & 18, move 16 to 19.
- +32 ;gef;IB*2.0*547 - added 20
- +33 ;JWS;IB*2.0*592 - added field 8.2 to 16
- +34 ;JWS;IB*2.0*623 - added field 8.21 to 16
- 1 ;;.09;.13;.14
- 2 ;;1.2;.15;.11;.12;7.04
- 3 ;;1.09;1.07;2.07
- 4 ;;4.04;6.25;6.24
- 5 ;;.02;1.14;1.25;1.08
- 6 ;;1.23;1.16;1.22;1.19;1.15;1.17
- 7 ;;1.33;1.32;1.31;1.27;8.14T;8.15T;8.16T;8.19T
- 9 ;;1.29;1.3;1.18;1.28
- 10 ;;1.01;1.02;1.05
- 13 ;;2.08;2.09
- 14 ;;11.01
- 15 ;;10.02;10.03;10.04;10.05;D INIT^IBATFILE
- 16 ;;2.11;8.01;8.09;8.03;8.06;8.04;8.07;8.02;8.12T;8.11T;8.17T;8.2T;8.21T
- 19 ;;50.01;50.02;50.05;50.06;50.03;50.04;50.07
- 20 ;;52.01;52.02
- +1 ;