- IBEMTF1 ;ALB/CPM - FLAG STOP CODES, DISPOSITIONS, AND CLINICS (CON'T.) ; 23-JUL-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- REV ; Review selected entries and de-select if necessary.
- W !!,"You have selected ",IBNUM," ",$P(IBINFO,";",3),"."
- S DIR(0)="Y",DIR("A")="Would you like to review these selections",DIR("?")="^D HREV^IBEMTF1"
- D ^DIR K DIR I 'Y!($D(DIRUT))!($D(DUOUT)) G REVQ
- ;
- ; - list selections and ask if user would like to de-select.
- D LIST W !
- S DIR(0)="Y",DIR("A")="Would you like to de-select any entries"
- S DIR("?")="Enter 'Y' to de-select entries, 'N' to continue, or '^' to quit."
- D ^DIR K DIR I 'Y!($D(DIRUT))!($D(DUOUT)) G REVQ
- ;
- ; - allow de-selection and pull entries from the list.
- S IBHIT=0 F D Q:Y<0
- .S DIC=$P(IBINFO,";",5),DIC(0)="QEAMZ"
- .S DIC("A")="De-select "_$S(IBHIT:"Next ",1:"")_$P(IBINFO,";",4)_": "
- .S:$P(IBINFO,";",6)]"" DIC("S")=$P(IBINFO,";",6)
- .D ^DIC K DIC Q:Y<0 S IBHIT=1
- .I '$D(^TMP("IBEMTF",$J,+Y)) W !,"Please note that ",Y(0,0)," is not currently selected."
- .E K ^TMP("IBEMTF",$J,+Y) S IBNUM=IBNUM-1
- W !!,"You have selected a total of ",IBNUM," ",$P(IBINFO,";",$S(IBNUM=1:7,1:3)),"."
- REVQ S:$D(DIRUT)!($D(DUOUT)) IBQ=1
- Q
- ;
- FILE ; File all selected entries.
- N IBI,IBIN,IBALR
- S IBI=0 F S IBI=$O(^TMP("IBEMTF",$J,IBI)) Q:'IBI S IBIN=^(IBI) D
- .K DD,DO,DIC,DR
- .S DIC=$P(IBINFO,";",8),DIC(0)="",X=IBI,DLAYGO=$P(IBINFO,";",9)
- .;
- .; - has this entry already been filed for this date?
- .S IBALR=$O(@(DIC_"""AIVDT"","_IBI_","_-IBDAT_",0)"))
- .;
- .; - add new entry if not yet on file for the specified date
- .I 'IBALR D FILE^DICN I Y<0 W !,"Unable to file ",IBIN,"..",! Q
- .S DIE=$P(IBINFO,";",8),DA=$S(IBALR:IBALR,1:+Y),DR=".02////"_IBDAT_";.03////"_IBFILE
- .D ^DIE K DA,DR,DIE W "."
- W " done!"
- Q
- ;
- LIST ; List all selected entries.
- W ! S I=0 F S I=$O(^TMP("IBEMTF",$J,I)) Q:'I W:$X>40 ! W:$X>2 ?40 W ^(I)
- Q
- ;
- HACT ; Help for the Billing action prompt.
- W !!,"Please enter:"
- W !," 'Y' to ignore Means Test billing for ",$S(IBNUM=1:"this",1:"these")," ",$P(IBINFO,";",$S(IBNUM=1:7,1:3))
- W !," 'N' to activate Means Test billing for ",$S(IBNUM=1:"this",1:"these")," ",$P(IBINFO,";",$S(IBNUM=1:7,1:3))
- W !," '^' to quit this option."
- Q
- ;
- HSEL ; Help for the Billing characteristic prompt.
- W !!,"Please enter:"
- W !," 'S' to ignore/activate Means Test Billing for Stop Codes"
- W !," 'D' to ignore/activate Means Test Billing for Dispositions"
- W !," 'C' to ignore/activate Means Test Billing for Clinics"
- W !," '^' to quit this option."
- Q
- ;
- HREV ; Help for the Request to Review prompt.
- W !!,"Enter 'Y' to review the selections, 'N' to continue, or '^' to quit."
- W !,"Please note that, if you choose to review the selections, you will have"
- W !,"the opportunity to de-select incorrect entries from the list."
- Q
- IBEMTF1 ;ALB/CPM - FLAG STOP CODES, DISPOSITIONS, AND CLINICS (CON'T.) ; 23-JUL-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- REV ; Review selected entries and de-select if necessary.
- +1 WRITE !!,"You have selected ",IBNUM," ",$PIECE(IBINFO,";",3),"."
- +2 SET DIR(0)="Y"
- SET DIR("A")="Would you like to review these selections"
- SET DIR("?")="^D HREV^IBEMTF1"
- +3 DO ^DIR
- KILL DIR
- IF 'Y!($DATA(DIRUT))!($DATA(DUOUT))
- GOTO REVQ
- +4 ;
- +5 ; - list selections and ask if user would like to de-select.
- +6 DO LIST
- WRITE !
- +7 SET DIR(0)="Y"
- SET DIR("A")="Would you like to de-select any entries"
- +8 SET DIR("?")="Enter 'Y' to de-select entries, 'N' to continue, or '^' to quit."
- +9 DO ^DIR
- KILL DIR
- IF 'Y!($DATA(DIRUT))!($DATA(DUOUT))
- GOTO REVQ
- +10 ;
- +11 ; - allow de-selection and pull entries from the list.
- +12 SET IBHIT=0
- FOR
- Begin DoDot:1
- +13 SET DIC=$PIECE(IBINFO,";",5)
- SET DIC(0)="QEAMZ"
- +14 SET DIC("A")="De-select "_$SELECT(IBHIT:"Next ",1:"")_$PIECE(IBINFO,";",4)_": "
- +15 IF $PIECE(IBINFO,";",6)]""
- SET DIC("S")=$PIECE(IBINFO,";",6)
- +16 DO ^DIC
- KILL DIC
- IF Y<0
- QUIT
- SET IBHIT=1
- +17 IF '$DATA(^TMP("IBEMTF",$JOB,+Y))
- WRITE !,"Please note that ",Y(0,0)," is not currently selected."
- +18 IF '$TEST
- KILL ^TMP("IBEMTF",$JOB,+Y)
- SET IBNUM=IBNUM-1
- End DoDot:1
- IF Y<0
- QUIT
- +19 WRITE !!,"You have selected a total of ",IBNUM," ",$PIECE(IBINFO,";",$SELECT(IBNUM=1:7,1:3)),"."
- REVQ IF $DATA(DIRUT)!($DATA(DUOUT))
- SET IBQ=1
- +1 QUIT
- +2 ;
- FILE ; File all selected entries.
- +1 NEW IBI,IBIN,IBALR
- +2 SET IBI=0
- FOR
- SET IBI=$ORDER(^TMP("IBEMTF",$JOB,IBI))
- IF 'IBI
- QUIT
- SET IBIN=^(IBI)
- Begin DoDot:1
- +3 KILL DD,DO,DIC,DR
- +4 SET DIC=$PIECE(IBINFO,";",8)
- SET DIC(0)=""
- SET X=IBI
- SET DLAYGO=$PIECE(IBINFO,";",9)
- +5 ;
- +6 ; - has this entry already been filed for this date?
- +7 SET IBALR=$ORDER(@(DIC_"""AIVDT"","_IBI_","_-IBDAT_",0)"))
- +8 ;
- +9 ; - add new entry if not yet on file for the specified date
- +10 IF 'IBALR
- DO FILE^DICN
- IF Y<0
- WRITE !,"Unable to file ",IBIN,"..",!
- QUIT
- +11 SET DIE=$PIECE(IBINFO,";",8)
- SET DA=$SELECT(IBALR:IBALR,1:+Y)
- SET DR=".02////"_IBDAT_";.03////"_IBFILE
- +12 DO ^DIE
- KILL DA,DR,DIE
- WRITE "."
- End DoDot:1
- +13 WRITE " done!"
- +14 QUIT
- +15 ;
- LIST ; List all selected entries.
- +1 WRITE !
- SET I=0
- FOR
- SET I=$ORDER(^TMP("IBEMTF",$JOB,I))
- IF 'I
- QUIT
- IF $X>40
- WRITE !
- IF $X>2
- WRITE ?40
- WRITE ^(I)
- +2 QUIT
- +3 ;
- HACT ; Help for the Billing action prompt.
- +1 WRITE !!,"Please enter:"
- +2 WRITE !," 'Y' to ignore Means Test billing for ",$SELECT(IBNUM=1:"this",1:"these")," ",$PIECE(IBINFO,";",$SELECT(IBNUM=1:7,1:3))
- +3 WRITE !," 'N' to activate Means Test billing for ",$SELECT(IBNUM=1:"this",1:"these")," ",$PIECE(IBINFO,";",$SELECT(IBNUM=1:7,1:3))
- +4 WRITE !," '^' to quit this option."
- +5 QUIT
- +6 ;
- HSEL ; Help for the Billing characteristic prompt.
- +1 WRITE !!,"Please enter:"
- +2 WRITE !," 'S' to ignore/activate Means Test Billing for Stop Codes"
- +3 WRITE !," 'D' to ignore/activate Means Test Billing for Dispositions"
- +4 WRITE !," 'C' to ignore/activate Means Test Billing for Clinics"
- +5 WRITE !," '^' to quit this option."
- +6 QUIT
- +7 ;
- HREV ; Help for the Request to Review prompt.
- +1 WRITE !!,"Enter 'Y' to review the selections, 'N' to continue, or '^' to quit."
- +2 WRITE !,"Please note that, if you choose to review the selections, you will have"
- +3 WRITE !,"the opportunity to de-select incorrect entries from the list."
- +4 QUIT
