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 Apr 09, 2024@21:37:35 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
