- DGBTR124 ;PAV - BENEFICIARY/TRAVEL E12.2 ROUTINE; 6/20/2012@1130 ;11/14/11 09:58
- ;;1.0;Beneficiary Travel;**20**;July 25, 2012;Build 185
- EN ;12.2 BT Travel Pattern Report
- W *7,!!," ************* BT Travel Pattern Report *************",!
- N DIR,A,AA,B,C,Y,X,I,DA,DIK,DIC,FDA,SDATE,EDATE,SNAME,ENAME,A,DFN,H1,H0,H2,SDATEP,EDATEP,TXT,EXIT,SPR,DEL,DGBTQ,VADM,RNAME,EXCEL,LINE,PAGE
- N XDATE,XNAME,XXDATE
- S (EXCEL,EXIT)=0,DEL=U
- DATE ;
- ;Beginning Date. Compared against the Claim entry date.
- K DIR S DIR("A")="START DATE: ",DIR(0)="DA^2991231:NOW:EX" D ^DIR K DIR
- D ^DIR G:(Y=U)!$G(DTOUT)!$G(DUOUT) EXIT
- S SDATE=Y,SDATEP=$$DP(SDATE),SDATE=SDATE-.0001
- ;Ending Date. Compared against the Claim entry date.
- K DIR S DIR("A")="END DATE: ",DIR(0)="DA^"_SDATE_":NOW:EX" D ^DIR K DIR
- D ^DIR G:(Y=U)!$G(DTOUT)!$G(DUOUT) EXIT
- S EDATE=Y,EDATEP=$$DP(EDATE)
- NAME ;
- ;The name of the first veteran to include in the report (last name). This can be a partial string. Default value is 'AAA'
- K DIR S DIR("A")="START NAME ",DIR("B")="AAA",DIR(0)="F^3:30" ;^K:X'?1A.A.A X"
- D ^DIR G:(Y=U)!$G(DTOUT)!$G(DUOUT) EXIT
- S SNAME=$$UP^XLFSTR(Y)
- ;The name of the last veteran to include in the report (last name). This can be a partial string. Default value is 'ZZZ'
- K DIR S DIR("A")="END NAME ",DIR("B")="ZZZ",DIR(0)="F^3:30" ;^K:X'?1A.A.A X"
- D ^DIR G:(Y=U)!$G(DTOUT)!$G(DUOUT) EXIT
- S ENAME=$$UP^XLFSTR(Y)
- I SNAME]ENAME W *7,!,"START NAME must be before LAST NAME",! G NAME
- S ENAME=ENAME_"Z"
- S AA="1,2,3,6,14,15,16,17,7,21,13,20,19"
- S RNAME=" BT Travel Pattern Report "
- S EXCEL=$$SELEXCEL^DGBTUTL() Q:EXCEL=U ;
- I 'EXCEL N COLWID S COLWID=255 D PRINTMSG^DGBTUTL
- S DGBTQ=0 D DEVICE^DGBTUTL(RNAME,"EN1^DGBTR124",EXCEL,255) Q:$G(DGBTQ)
- EN1 ;start computation
- S B(0)="DATE ENT^10",B(1)="CLAIM DATE^13",B(2)="PATIENT NAME^25",B(3)="SSN^15",B(4)="ELIG^20",B(5)="SC %^6"
- S B(6)="ACCT^8",B(7)="R/O^5",B(8)="TOT MILES^10",B(9)="CC MODE^11",B(10)="CC FEE^10",B(11)="ECON^9"
- S B(12)="DED^9",B(13)="PAYABLE^9",B(14)="DEP ADDRESS^20",B(15)="DEP CITY^15",B(16)="DEP STATE^18"
- S B(17)="DEP ZIP^8",B(18)="DIV^5",B(19)="REMARKS^45",B(20)="CLERK^18",B(21)="MILEAGE^8"
- S C(0)="DATE ENTERED^10",C(1)="CLAIM DATE^14",C(2)="PATIENT NAME^16",C(3)="SSN^13",C(4)="ELIGIBILITY^16",C(5)="SC PERCENTAGE^5"
- S C(6)="ACCOUNT^16",C(7)="R/O^5",C(8)="TOTAL MILEAGE^7",C(9)="CC MODE^11",C(10)="CC FEE^10",C(11)="MOST ECONOMICAL^9"
- S C(12)="DEDUCTIBLE AMOUNT^7",C(13)="AMOUNT PAYABLE^7",C(14)="PLACE OF DEPARTURE^14",C(15)="CITY OF DEPARTURE^12",C(16)="STATE OF DEPARTURE^14"
- S C(17)="ZIP CODE OF DEPARTURE^8",C(18)="DIVISION^5",C(19)="REMARKS^42",C(20)="WHO ENTERED INTO FILE^18",C(21)="MILES^6" ;,C(21)="MILES ONE WAY^8"
- S PAGE=0,LINE=99999,$P(H1,"-",IOM-1)="-"
- S H0="*************"_RNAME_SDATEP_"-"_EDATEP_" *************",H2=" "
- S XDATE=SDATE F S XDATE=$O(^DGBT(392,"D",XDATE)) Q:'XDATE!(XDATE>EDATE) D Q:EXIT
- .S XXDATE="" F S XXDATE=$O(^DGBT(392,"D",XDATE,XXDATE)) Q:'XXDATE D Q:EXIT
- ..K FDA,A D GETS^DIQ(392,XXDATE_",","**","EI","FDA") Q:'$D(FDA) ;ZW FDA S EXIT=1 Q
- ..S XNAME=$$UP^XLFSTR(FDA(392,XXDATE_",",2,"E")),XNAME=$P(XNAME,U),XNAME=$TR(XNAME,"-"," "),XNAME=$TR(XNAME,"/"," ")
- ..Q:XNAME]ENAME!(SNAME]XNAME) ;Quit if not between names
- ..Q:FDA(392,XXDATE_",",45.2,"I") ;Quit if Denied Claim
- ..Q:FDA(392,XXDATE_",",56,"I")="S" ; Quit if Special Mode
- ..S A(0)=$$DP(FDA(392,XXDATE_",",13,"I")) ;Date Claim entered
- ..S A(1)=$$DP(FDA(392,XXDATE_",",.01,"I")) ;Claim Date
- ..S A(2)=FDA(392,XXDATE_",",2,"E") ;Patient Name
- ..S DFN=FDA(392,XXDATE_",",2,"I") D DEM^VADPT
- ..S A(3)=$P(VADM(2),U,2) ;SSN
- ..S A(4)=FDA(392,XXDATE_",",3,"E") ;Eligibility
- ..S A(5)=FDA(392,XXDATE_",",4,"E") ;SC Percentage
- ..S A(6)=+FDA(392,XXDATE_",",6,"E") ;Account
- ..S A(7)=$E(FDA(392,XXDATE_",",31,"E"),1) ;One Way/Round Trip
- ..S A(8)=$$DLRAMT(FDA(392,XXDATE_",",33,"E")) ;Total Mileage
- ..S A(9)=FDA(392,XXDATE_",",44,"E") ;Common Carrier mode
- ..S A(10)=$$DLRAMT(FDA(392,XXDATE_",",55,"E")) ;Common Carrier fee
- ..S A(11)=$$DLRAMT(FDA(392,XXDATE_",",8,"E")) ;Most economical cost
- ..S A(12)=$$DLRAMT(FDA(392,XXDATE_",",9,"E")) ;Deductible amount
- ..S A(13)=$$DLRAMT(FDA(392,XXDATE_",",10,"E")) ;Amount payable
- ..S A(14)=FDA(392,XXDATE_",",21,"E") ;Place of departure
- ..S A(15)=FDA(392,XXDATE_",",24,"E") ;City of departure
- ..S A(16)=FDA(392,XXDATE_",",24.1,"E") ;State of departure
- ..S A(17)=FDA(392,XXDATE_",",24.2,"E") ;Zip code of departure
- ..S A(18)=FDA(392,XXDATE_",",11,"E") ;Division
- ..S A(19)=FDA(392,XXDATE_",",51,"E") ;Remarks
- ..S A(20)=FDA(392,XXDATE_",",12,"E") ;WHO ENTERED INTO FILE
- ..S A(21)=FDA(392,XXDATE_",",32,"E") ;MILEAGE/ONE WAY
- ..S:A(7)="R" A(21)=A(21)*2 ;If roud trip double miles
- ..I FDA(392,XXDATE_",",56,"I")="S" D ;Handle special mode
- ...S A(8)=FDA(392,XXDATE_",",60,"E") ;SP Total Invoice Amount
- ...S A(7)=$E(FDA(392,XXDATE_",",67,"E"),1) ;SP One Way / Round Trip
- ...S A(21)=FDA(392,XXDATE_",",68,"E") ;SP Total miles ??
- ...S A(14)=FDA(392,XXDATE_",",73,"E") ;SP Place of departure
- ...S A(15)=FDA(392,XXDATE_",",75,"E") ;SP City of departure
- ...S A(16)=FDA(392,XXDATE_",",76,"E") ;SP State of departure
- ...S A(17)=FDA(392,XXDATE_",",77,"E") ;SP Zip code of departure
- ...S A(19)=FDA(392,XXDATE_",",72,"E") ;SP Remarks
- ..I EXCEL D EXCEL Q
- ..D PRINT
- I IOST["C-" S TT=$$PAUSE^DGBTUTL(EXCEL)
- I IOST'["C-" W !,"REPORT HAS FINISHED"
- D ^%ZISC
- Q
- PRINT ;
- N L,T1,TT
- D:LINE>IOSL HEADER Q:EXIT
- S TXT="",L=0
- F L=1:1 S I=$P(AA,",",L) Q:'I S T1=$P(B(I),U,2)-$L(A(I)) S:T1'>0 T1=1 S TXT=TXT_$E(A(I),1,$P(B(I),U,2)-1)_$S(I=19:"",1:$E(H2,1,T1))
- U IO F I=0:IOM S TT=$E(TXT,I+1,I+IOM) Q:'$L(TT) W !,TT
- S LINE=LINE+($L(TXT)\IOM)+3
- U IO W !
- Q
- S PAGE=PAGE+1,L=0,TXT="",TT=""
- I LINE'=99999,$E(IOST,1,4)="C-VT" U IO S TT=$$PAUSE() I TT[U S EXIT=1 Q
- U IO W @IOF,?IOM/2-35,H0," Page: ",PAGE,!,H1
- F L=1:1 S I=$P(AA,",",L) Q:'I S T1=$P(B(I),U,2)-$L($P(B(I),U)) S TXT=TXT_$P(B(I),U)_$E(H2,1,T1)
- U IO F I=0:IOM S TT=$E(TXT,I+1,I+IOM) Q:'$L(TT) W !,TT
- U IO W !,H1 S LINE=5
- Q
- DP(DATE) ;Set printable date
- Q $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
- EXCEL ;Print to spreadsheet
- D:LINE=99999
- .S LINE=0,TXT="" F L=1:1 S I=$P(AA,",",L) Q:'I S TXT=TXT_$TR($P(C(I),U),DEL," ")_$S(I=19:"",1:DEL)
- .U IO W !,TXT
- S TXT="" F L=1:1 S I=$P(AA,",",L) Q:'I S TXT=TXT_$TR(A(I),DEL," ")_$S(I=19:"",1:DEL)
- U IO W !,TXT
- Q
- DLRAMT(X) D COMMA^%DTC Q $S(EXCEL:"",1:"$")_$TR(X," ","")
- EXIT ;
- Q
- PAUSE(X) ;Local pause
- N DIR,Y
- S X=$G(X,"PRESS RETURN TO CONTINUE OR '^' TO STOP")
- S DIR("A")=X,DIR(0)="FAO" D ^DIR
- Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGBTR124 7120 printed Feb 18, 2025@23:07:23 Page 2
- DGBTR124 ;PAV - BENEFICIARY/TRAVEL E12.2 ROUTINE; 6/20/2012@1130 ;11/14/11 09:58
- +1 ;;1.0;Beneficiary Travel;**20**;July 25, 2012;Build 185
- EN ;12.2 BT Travel Pattern Report
- +1 WRITE *7,!!," ************* BT Travel Pattern Report *************",!
- +2 NEW DIR,A,AA,B,C,Y,X,I,DA,DIK,DIC,FDA,SDATE,EDATE,SNAME,ENAME,A,DFN,H1,H0,H2,SDATEP,EDATEP,TXT,EXIT,SPR,DEL,DGBTQ,VADM,RNAME,EXCEL,LINE,PAGE
- +3 NEW XDATE,XNAME,XXDATE
- +4 SET (EXCEL,EXIT)=0
- SET DEL=U
- DATE ;
- +1 ;Beginning Date. Compared against the Claim entry date.
- +2 KILL DIR
- SET DIR("A")="START DATE: "
- SET DIR(0)="DA^2991231:NOW:EX"
- DO ^DIR
- KILL DIR
- +3 DO ^DIR
- if (Y=U)!$GET(DTOUT)!$GET(DUOUT)
- GOTO EXIT
- +4 SET SDATE=Y
- SET SDATEP=$$DP(SDATE)
- SET SDATE=SDATE-.0001
- +5 ;Ending Date. Compared against the Claim entry date.
- +6 KILL DIR
- SET DIR("A")="END DATE: "
- SET DIR(0)="DA^"_SDATE_":NOW:EX"
- DO ^DIR
- KILL DIR
- +7 DO ^DIR
- if (Y=U)!$GET(DTOUT)!$GET(DUOUT)
- GOTO EXIT
- +8 SET EDATE=Y
- SET EDATEP=$$DP(EDATE)
- NAME ;
- +1 ;The name of the first veteran to include in the report (last name). This can be a partial string. Default value is 'AAA'
- +2 ;^K:X'?1A.A.A X"
- KILL DIR
- SET DIR("A")="START NAME "
- SET DIR("B")="AAA"
- SET DIR(0)="F^3:30"
- +3 DO ^DIR
- if (Y=U)!$GET(DTOUT)!$GET(DUOUT)
- GOTO EXIT
- +4 SET SNAME=$$UP^XLFSTR(Y)
- +5 ;The name of the last veteran to include in the report (last name). This can be a partial string. Default value is 'ZZZ'
- +6 ;^K:X'?1A.A.A X"
- KILL DIR
- SET DIR("A")="END NAME "
- SET DIR("B")="ZZZ"
- SET DIR(0)="F^3:30"
- +7 DO ^DIR
- if (Y=U)!$GET(DTOUT)!$GET(DUOUT)
- GOTO EXIT
- +8 SET ENAME=$$UP^XLFSTR(Y)
- +9 IF SNAME]ENAME
- WRITE *7,!,"START NAME must be before LAST NAME",!
- GOTO NAME
- +10 SET ENAME=ENAME_"Z"
- +11 SET AA="1,2,3,6,14,15,16,17,7,21,13,20,19"
- +12 SET RNAME=" BT Travel Pattern Report "
- +13 ;
- SET EXCEL=$$SELEXCEL^DGBTUTL()
- if EXCEL=U
- QUIT
- +14 IF 'EXCEL
- NEW COLWID
- SET COLWID=255
- DO PRINTMSG^DGBTUTL
- +15 SET DGBTQ=0
- DO DEVICE^DGBTUTL(RNAME,"EN1^DGBTR124",EXCEL,255)
- if $GET(DGBTQ)
- QUIT
- EN1 ;start computation
- +1 SET B(0)="DATE ENT^10"
- SET B(1)="CLAIM DATE^13"
- SET B(2)="PATIENT NAME^25"
- SET B(3)="SSN^15"
- SET B(4)="ELIG^20"
- SET B(5)="SC %^6"
- +2 SET B(6)="ACCT^8"
- SET B(7)="R/O^5"
- SET B(8)="TOT MILES^10"
- SET B(9)="CC MODE^11"
- SET B(10)="CC FEE^10"
- SET B(11)="ECON^9"
- +3 SET B(12)="DED^9"
- SET B(13)="PAYABLE^9"
- SET B(14)="DEP ADDRESS^20"
- SET B(15)="DEP CITY^15"
- SET B(16)="DEP STATE^18"
- +4 SET B(17)="DEP ZIP^8"
- SET B(18)="DIV^5"
- SET B(19)="REMARKS^45"
- SET B(20)="CLERK^18"
- SET B(21)="MILEAGE^8"
- +5 SET C(0)="DATE ENTERED^10"
- SET C(1)="CLAIM DATE^14"
- SET C(2)="PATIENT NAME^16"
- SET C(3)="SSN^13"
- SET C(4)="ELIGIBILITY^16"
- SET C(5)="SC PERCENTAGE^5"
- +6 SET C(6)="ACCOUNT^16"
- SET C(7)="R/O^5"
- SET C(8)="TOTAL MILEAGE^7"
- SET C(9)="CC MODE^11"
- SET C(10)="CC FEE^10"
- SET C(11)="MOST ECONOMICAL^9"
- +7 SET C(12)="DEDUCTIBLE AMOUNT^7"
- SET C(13)="AMOUNT PAYABLE^7"
- SET C(14)="PLACE OF DEPARTURE^14"
- SET C(15)="CITY OF DEPARTURE^12"
- SET C(16)="STATE OF DEPARTURE^14"
- +8 ;,C(21)="MILES ONE WAY^8"
- SET C(17)="ZIP CODE OF DEPARTURE^8"
- SET C(18)="DIVISION^5"
- SET C(19)="REMARKS^42"
- SET C(20)="WHO ENTERED INTO FILE^18"
- SET C(21)="MILES^6"
- +9 SET PAGE=0
- SET LINE=99999
- SET $PIECE(H1,"-",IOM-1)="-"
- +10 SET H0="*************"_RNAME_SDATEP_"-"_EDATEP_" *************"
- SET H2=" "
- +11 SET XDATE=SDATE
- FOR
- SET XDATE=$ORDER(^DGBT(392,"D",XDATE))
- if 'XDATE!(XDATE>EDATE)
- QUIT
- Begin DoDot:1
- +12 SET XXDATE=""
- FOR
- SET XXDATE=$ORDER(^DGBT(392,"D",XDATE,XXDATE))
- if 'XXDATE
- QUIT
- Begin DoDot:2
- +13 ;ZW FDA S EXIT=1 Q
- KILL FDA,A
- DO GETS^DIQ(392,XXDATE_",","**","EI","FDA")
- if '$DATA(FDA)
- QUIT
- +14 SET XNAME=$$UP^XLFSTR(FDA(392,XXDATE_",",2,"E"))
- SET XNAME=$PIECE(XNAME,U)
- SET XNAME=$TRANSLATE(XNAME,"-"," ")
- SET XNAME=$TRANSLATE(XNAME,"/"," ")
- +15 ;Quit if not between names
- if XNAME]ENAME!(SNAME]XNAME)
- QUIT
- +16 ;Quit if Denied Claim
- if FDA(392,XXDATE_",",45.2,"I")
- QUIT
- +17 ; Quit if Special Mode
- if FDA(392,XXDATE_",",56,"I")="S"
- QUIT
- +18 ;Date Claim entered
- SET A(0)=$$DP(FDA(392,XXDATE_",",13,"I"))
- +19 ;Claim Date
- SET A(1)=$$DP(FDA(392,XXDATE_",",.01,"I"))
- +20 ;Patient Name
- SET A(2)=FDA(392,XXDATE_",",2,"E")
- +21 SET DFN=FDA(392,XXDATE_",",2,"I")
- DO DEM^VADPT
- +22 ;SSN
- SET A(3)=$PIECE(VADM(2),U,2)
- +23 ;Eligibility
- SET A(4)=FDA(392,XXDATE_",",3,"E")
- +24 ;SC Percentage
- SET A(5)=FDA(392,XXDATE_",",4,"E")
- +25 ;Account
- SET A(6)=+FDA(392,XXDATE_",",6,"E")
- +26 ;One Way/Round Trip
- SET A(7)=$EXTRACT(FDA(392,XXDATE_",",31,"E"),1)
- +27 ;Total Mileage
- SET A(8)=$$DLRAMT(FDA(392,XXDATE_",",33,"E"))
- +28 ;Common Carrier mode
- SET A(9)=FDA(392,XXDATE_",",44,"E")
- +29 ;Common Carrier fee
- SET A(10)=$$DLRAMT(FDA(392,XXDATE_",",55,"E"))
- +30 ;Most economical cost
- SET A(11)=$$DLRAMT(FDA(392,XXDATE_",",8,"E"))
- +31 ;Deductible amount
- SET A(12)=$$DLRAMT(FDA(392,XXDATE_",",9,"E"))
- +32 ;Amount payable
- SET A(13)=$$DLRAMT(FDA(392,XXDATE_",",10,"E"))
- +33 ;Place of departure
- SET A(14)=FDA(392,XXDATE_",",21,"E")
- +34 ;City of departure
- SET A(15)=FDA(392,XXDATE_",",24,"E")
- +35 ;State of departure
- SET A(16)=FDA(392,XXDATE_",",24.1,"E")
- +36 ;Zip code of departure
- SET A(17)=FDA(392,XXDATE_",",24.2,"E")
- +37 ;Division
- SET A(18)=FDA(392,XXDATE_",",11,"E")
- +38 ;Remarks
- SET A(19)=FDA(392,XXDATE_",",51,"E")
- +39 ;WHO ENTERED INTO FILE
- SET A(20)=FDA(392,XXDATE_",",12,"E")
- +40 ;MILEAGE/ONE WAY
- SET A(21)=FDA(392,XXDATE_",",32,"E")
- +41 ;If roud trip double miles
- if A(7)="R"
- SET A(21)=A(21)*2
- +42 ;Handle special mode
- IF FDA(392,XXDATE_",",56,"I")="S"
- Begin DoDot:3
- +43 ;SP Total Invoice Amount
- SET A(8)=FDA(392,XXDATE_",",60,"E")
- +44 ;SP One Way / Round Trip
- SET A(7)=$EXTRACT(FDA(392,XXDATE_",",67,"E"),1)
- +45 ;SP Total miles ??
- SET A(21)=FDA(392,XXDATE_",",68,"E")
- +46 ;SP Place of departure
- SET A(14)=FDA(392,XXDATE_",",73,"E")
- +47 ;SP City of departure
- SET A(15)=FDA(392,XXDATE_",",75,"E")
- +48 ;SP State of departure
- SET A(16)=FDA(392,XXDATE_",",76,"E")
- +49 ;SP Zip code of departure
- SET A(17)=FDA(392,XXDATE_",",77,"E")
- +50 ;SP Remarks
- SET A(19)=FDA(392,XXDATE_",",72,"E")
- End DoDot:3
- +51 IF EXCEL
- DO EXCEL
- QUIT
- +52 DO PRINT
- End DoDot:2
- if EXIT
- QUIT
- End DoDot:1
- if EXIT
- QUIT
- +53 IF IOST["C-"
- SET TT=$$PAUSE^DGBTUTL(EXCEL)
- +54 IF IOST'["C-"
- WRITE !,"REPORT HAS FINISHED"
- +55 DO ^%ZISC
- +56 QUIT
- PRINT ;
- +1 NEW L,T1,TT
- +2 if LINE>IOSL
- DO HEADER
- if EXIT
- QUIT
- +3 SET TXT=""
- SET L=0
- +4 FOR L=1:1
- SET I=$PIECE(AA,",",L)
- if 'I
- QUIT
- SET T1=$PIECE(B(I),U,2)-$LENGTH(A(I))
- if T1'>0
- SET T1=1
- SET TXT=TXT_$EXTRACT(A(I),1,$PIECE(B(I),U,2)-1)_$SELECT(I=19:"",1:$EXTRACT(H2,1,T1))
- +5 USE IO
- FOR I=0:IOM
- SET TT=$EXTRACT(TXT,I+1,I+IOM)
- if '$LENGTH(TT)
- QUIT
- WRITE !,TT
- +6 SET LINE=LINE+($LENGTH(TXT)\IOM)+3
- +7 USE IO
- WRITE !
- +8 QUIT
- +1 SET PAGE=PAGE+1
- SET L=0
- SET TXT=""
- SET TT=""
- +2 IF LINE'=99999
- IF $EXTRACT(IOST,1,4)="C-VT"
- USE IO
- SET TT=$$PAUSE()
- IF TT[U
- SET EXIT=1
- QUIT
- +3 USE IO
- WRITE @IOF,?IOM/2-35,H0," Page: ",PAGE,!,H1
- +4 FOR L=1:1
- SET I=$PIECE(AA,",",L)
- if 'I
- QUIT
- SET T1=$PIECE(B(I),U,2)-$LENGTH($PIECE(B(I),U))
- SET TXT=TXT_$PIECE(B(I),U)_$EXTRACT(H2,1,T1)
- +5 USE IO
- FOR I=0:IOM
- SET TT=$EXTRACT(TXT,I+1,I+IOM)
- if '$LENGTH(TT)
- QUIT
- WRITE !,TT
- +6 USE IO
- WRITE !,H1
- SET LINE=5
- +7 QUIT
- DP(DATE) ;Set printable date
- +1 QUIT $EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)
- EXCEL ;Print to spreadsheet
- +1 if LINE=99999
- Begin DoDot:1
- +2 SET LINE=0
- SET TXT=""
- FOR L=1:1
- SET I=$PIECE(AA,",",L)
- if 'I
- QUIT
- SET TXT=TXT_$TRANSLATE($PIECE(C(I),U),DEL," ")_$SELECT(I=19:"",1:DEL)
- +3 USE IO
- WRITE !,TXT
- End DoDot:1
- +4 SET TXT=""
- FOR L=1:1
- SET I=$PIECE(AA,",",L)
- if 'I
- QUIT
- SET TXT=TXT_$TRANSLATE(A(I),DEL," ")_$SELECT(I=19:"",1:DEL)
- +5 USE IO
- WRITE !,TXT
- +6 QUIT
- DLRAMT(X) DO COMMA^%DTC
- QUIT $SELECT(EXCEL:"",1:"$")_$TRANSLATE(X," ","")
- EXIT ;
- +1 QUIT
- PAUSE(X) ;Local pause
- +1 NEW DIR,Y
- +2 SET X=$GET(X,"PRESS RETURN TO CONTINUE OR '^' TO STOP")
- +3 SET DIR("A")=X
- SET DIR(0)="FAO"
- DO ^DIR
- +4 QUIT Y