- IBJPI5 ;ENS/GSS - IBJP5 eIV SITE PARAMETERS SCREEN ;30-AUG-2010
- ;;2.0;INTEGRATED BILLING;**438,497**;31-AUG-10;Build 120
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ; eIV - Electronic Insurance Verification Site Selected Service Type Codes
- ;
- Q
- ;
- EN ; main entry point for IBJP EIV SITE SELECTED CODES
- N DIR,I,IBDIRS,IBFLD,IBMAXDSC,IBSTCDF,IBSTCDFI,IBSTCR,X,Y
- ;
- D INIT,BLD
- ;
- EXIT ; Exit
- K ^TMP("IBJPI5",$J)
- S VALMBCK="R"
- Q
- ;
- INIT ; Initialize
- S IBMAXDSC=1 ; max # of DEFAULT STCs
- ; IBSTCDF=default STC IENs which herein remain unchanged
- S IBSTCDF=$G(^IBE(350.9,1,60)),IBSTCDFI=U_IBSTCDF_U
- Q
- ;
- BLD ; Build screen and prompt for action
- N DIR,X,Y
- W @IOF,IORVON,"Service Type Codes",IORVOFF
- W !!,IOUON,"Default Service Type Codes",IOUOFF
- F IBFLD=1:1:IBMAXDSC D
- . S IBSTCR=^IBE(365.013,$P(IBSTCDF,U,IBFLD),0)
- . W:IBFLD#2=1 !
- . W:IBFLD#2=0 ?40 W $J($P(IBSTCR,U,1),2)," - ",$P(IBSTCR,U,2)
- F IBFLD=IBFLD:1:20 W !
- W !,IORVON," Enter ?? for more information ",IORVOFF
- W !,"EX Exit"
- S DIR("A")="Select Action: Exit//"
- S DIR(0)="SAO^EX:Exit^"
- S DIR("?")="^D HELP1^IBJPI5"
- S DIR("??")="^D HELP2^IBJPI5"
- D ACTN
- I $F("^E",X) Q
- G BLD
- ;
- ACTN ;
- D ^DIR
- S X=$E(X,1),X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- I '$F("^E",X) G ACTN
- Q
- ;
- HELP1 ; Display actions in response to '?' entry
- D FULL^VALM1
- W @IOF
- Q
- ;
- HELP2 ; Text to display in response to '??' entry
- N DIR
- D FULL^VALM1
- W @IOF
- W !,"The DEFAULT SERVICE TYPE CODES are not editable but defined by CBO."
- W !,"Action available is 'EX' to Exit"
- W !,"Enter '^' to quit."
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJPI5 1718 printed Feb 18, 2025@23:49:57 Page 2
- IBJPI5 ;ENS/GSS - IBJP5 eIV SITE PARAMETERS SCREEN ;30-AUG-2010
- +1 ;;2.0;INTEGRATED BILLING;**438,497**;31-AUG-10;Build 120
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ; eIV - Electronic Insurance Verification Site Selected Service Type Codes
- +5 ;
- +6 QUIT
- +7 ;
- EN ; main entry point for IBJP EIV SITE SELECTED CODES
- +1 NEW DIR,I,IBDIRS,IBFLD,IBMAXDSC,IBSTCDF,IBSTCDFI,IBSTCR,X,Y
- +2 ;
- +3 DO INIT
- DO BLD
- +4 ;
- EXIT ; Exit
- +1 KILL ^TMP("IBJPI5",$JOB)
- +2 SET VALMBCK="R"
- +3 QUIT
- +4 ;
- INIT ; Initialize
- +1 ; max # of DEFAULT STCs
- SET IBMAXDSC=1
- +2 ; IBSTCDF=default STC IENs which herein remain unchanged
- +3 SET IBSTCDF=$GET(^IBE(350.9,1,60))
- SET IBSTCDFI=U_IBSTCDF_U
- +4 QUIT
- +5 ;
- BLD ; Build screen and prompt for action
- +1 NEW DIR,X,Y
- +2 WRITE @IOF,IORVON,"Service Type Codes",IORVOFF
- +3 WRITE !!,IOUON,"Default Service Type Codes",IOUOFF
- +4 FOR IBFLD=1:1:IBMAXDSC
- Begin DoDot:1
- +5 SET IBSTCR=^IBE(365.013,$PIECE(IBSTCDF,U,IBFLD),0)
- +6 if IBFLD#2=1
- WRITE !
- +7 if IBFLD#2=0
- WRITE ?40
- WRITE $JUSTIFY($PIECE(IBSTCR,U,1),2)," - ",$PIECE(IBSTCR,U,2)
- End DoDot:1
- +8 FOR IBFLD=IBFLD:1:20
- WRITE !
- +9 WRITE !,IORVON," Enter ?? for more information ",IORVOFF
- +10 WRITE !,"EX Exit"
- +11 SET DIR("A")="Select Action: Exit//"
- +12 SET DIR(0)="SAO^EX:Exit^"
- +13 SET DIR("?")="^D HELP1^IBJPI5"
- +14 SET DIR("??")="^D HELP2^IBJPI5"
- +15 DO ACTN
- +16 IF $FIND("^E",X)
- QUIT
- +17 GOTO BLD
- +18 ;
- ACTN ;
- +1 DO ^DIR
- +2 SET X=$EXTRACT(X,1)
- SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- +3 IF '$FIND("^E",X)
- GOTO ACTN
- +4 QUIT
- +5 ;
- HELP1 ; Display actions in response to '?' entry
- +1 DO FULL^VALM1
- +2 WRITE @IOF
- +3 QUIT
- +4 ;
- HELP2 ; Text to display in response to '??' entry
- +1 NEW DIR
- +2 DO FULL^VALM1
- +3 WRITE @IOF
- +4 WRITE !,"The DEFAULT SERVICE TYPE CODES are not editable but defined by CBO."
- +5 WRITE !,"Action available is 'EX' to Exit"
- +6 WRITE !,"Enter '^' to quit."
- +7 QUIT