- IBATLM1 ;LL/ELZ - TRANSFER PRICING PT TRANSACTION LIST MANAGER ; 10-SEP-1998
- ;;2.0;INTEGRATED BILLING;**115**;21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- EN(DFN) ; -- main entry point for IBAT PT TRANS LIST
- D EN^VALM("IBAT PT TRANS LIST")
- Q
- ;
- HDR ; -- header code
- N IBNAM,INST S IBNAM=$$PT^IBEFUNC(DFN)
- S IBNAM=$E("Patient: "_$P(IBNAM,"^"),1,25)_" "_$E(IBNAM)_$P(IBNAM,"^",3)
- S VALMHDR(1)=$$SETSTR^VALM1($$FDATE^VALM1(IBBDT)_" THRU "_$$FDATE^VALM1(IBEDT),IBNAM,59,22)
- S INST=$$INST^IBATUTL($$PPF^IBATUTL(DFN))
- S VALMHDR(2)="Enrolled Facility: "_$P(INST,"^")_" ("_$P(INST,"^",2)_")"
- S VALMHDR(2)=$$SETSTR^VALM1("Current Status: "_$$LOWER^VALM1($$EX^IBATUTL(351.6,.04,$P(^IBAT(351.6,DFN,0),"^",4))),VALMHDR(2),57,24)
- Q
- ;
- INIT ; -- init variables and list array
- K ^TMP("VALM DATA",$J),^TMP("VALMAR",$J)
- I $$SLDR^IBATUTL("Date range will be used to specify Event Dates of transactions shown.") S VALMQUIT="" G EXIT
- S VALMBCK="R"
- D ARRAY^IBATLM1A(VALMAR)
- Q
- ;
- HELP ; -- help code
- S X="?" D DISP^XQORM1 W !!
- Q
- ;
- EXIT ; -- exit code
- K IBDTR,IBEDT,IBBDT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBATLM1 1139 printed Feb 18, 2025@23:34:15 Page 2
- IBATLM1 ;LL/ELZ - TRANSFER PRICING PT TRANSACTION LIST MANAGER ; 10-SEP-1998
- +1 ;;2.0;INTEGRATED BILLING;**115**;21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- EN(DFN) ; -- main entry point for IBAT PT TRANS LIST
- +1 DO EN^VALM("IBAT PT TRANS LIST")
- +2 QUIT
- +3 ;
- HDR ; -- header code
- +1 NEW IBNAM,INST
- SET IBNAM=$$PT^IBEFUNC(DFN)
- +2 SET IBNAM=$EXTRACT("Patient: "_$PIECE(IBNAM,"^"),1,25)_" "_$EXTRACT(IBNAM)_$PIECE(IBNAM,"^",3)
- +3 SET VALMHDR(1)=$$SETSTR^VALM1($$FDATE^VALM1(IBBDT)_" THRU "_$$FDATE^VALM1(IBEDT),IBNAM,59,22)
- +4 SET INST=$$INST^IBATUTL($$PPF^IBATUTL(DFN))
- +5 SET VALMHDR(2)="Enrolled Facility: "_$PIECE(INST,"^")_" ("_$PIECE(INST,"^",2)_")"
- +6 SET VALMHDR(2)=$$SETSTR^VALM1("Current Status: "_$$LOWER^VALM1($$EX^IBATUTL(351.6,.04,$PIECE(^IBAT(351.6,DFN,0),"^",4))),VALMHDR(2),57,24)
- +7 QUIT
- +8 ;
- INIT ; -- init variables and list array
- +1 KILL ^TMP("VALM DATA",$JOB),^TMP("VALMAR",$JOB)
- +2 IF $$SLDR^IBATUTL("Date range will be used to specify Event Dates of transactions shown.")
- SET VALMQUIT=""
- GOTO EXIT
- +3 SET VALMBCK="R"
- +4 DO ARRAY^IBATLM1A(VALMAR)
- +5 QUIT
- +6 ;
- HELP ; -- help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
- +3 ;
- EXIT ; -- exit code
- +1 KILL IBDTR,IBEDT,IBBDT
- +2 QUIT