- RMPR4P24 ;PHX/HPL-Print patient PC notification letter ;10/31/1994
- ;;3.0;PROSTHETICS;**3,20,55,161**;Feb 09, 1996;Build 2
- ;
- ; ODJ - patch 55 - 1/29/01 - replace hard coded mail route code 121
- ; with call to extrinsic for site param.
- ; see nois AUG-1097-32118
- ;
- EN(RDA) ;SETUP VARIABLES AND PRINT PATIENT NOTIFICATION LETTER
- ;VARIABLE REQUIRED:RDA - ENTRY # IN FILE 664
- N VAHOW
- S NAME=$P(^RMPR(664,RDA,0),U,9),RMPRINIT=NAME,RMPREMP=$$SIG^RMPR31U(NAME)
- I $D(^VA(200,RMPRINIT,.13)) S RMPRPHON=$P(^VA(200,RMPRINIT,.13),U,2)
- I '$D(^VA(200,$P(^RMPR(664,RDA,0),U,9),.13)) S RMPRPHON=RMPR("PHONE")
- S DFN=$P(^RMPR(664,RDA,0),U,2) D ADD^VADPT,DEM^VADPT
- S RMPRITEM=""
- S RMPRITM=0 F LP=1:1 S RMPRITM=$O(^RMPR(664,RDA,1,RMPRITM)) Q:RMPRITM="B" S RMPRITEM(LP)=$P(^RMPR(664,RDA,1,RMPRITM,0),U,2),RMPRITM(LP)=$P(^RMPR(664,RDA,1,RMPRITM,0),U,1)
- S HEADING="Department of Veterans Affairs"
- W !!!!!,?IOM-$L(HEADING)\2,HEADING
- S RMPRTAB=IOM-$L(RMPR("NAME"))\2 W !,?RMPRTAB,RMPR("NAME")
- S RMPRTAB=IOM-$L(RMPR("ADD"))\2 W !,?RMPRTAB,RMPR("ADD")
- S RMPRTAB=IOM-$L(RMPR("CITY"))\2 W !,?RMPRTAB,RMPR("CITY")
- S RMPRTAB=7 S NAME=VADM(1) S FIXDNAME=$$PARS^RMPRUTL1(NAME)
- W !!,?44,$$FMTE^XLFDT(DT,"D")
- S FIXDNAME=$E(FIXDNAME,2,$L(FIXDNAME)-2)
- W !!,?RMPRTAB,$S($P(VADM(5),U,1)["M":"MR. ",$P(VADM(5),U,1)["F":"MS. ",1:"")_$$UP^XLFSTR(FIXDNAME)
- W ?44,"In reply refer to: ",$P(^DIC(4,RMPR("STA"),99),U,1)_"/"_$$ROU^RMPRUTIL(RMPRSITE),!
- ;display purchase card transaction
- W:VAPA(1)'="" ?RMPRTAB,VAPA(1)
- W:VAPA(2)'="" ?RMPRTAB,VAPA(2)
- W ?44,"Accounting Symbol ",$P(^RMPR(664,RDA,4),U,5),!
- W:VAPA(3)'="" ?RMPRTAB,VAPA(3)
- W:VAPA(4)'="" ?RMPRTAB,VAPA(4)_", "_$P(VAPA(5),"^",2)_" "_VAPA(6)
- W ?44,"Veteran: ",VADM(1),!
- ; *161 removed old line which printed SSN
- W !!,?RMPRTAB,"Dear ",$S($P(VADM(5),"^",1)["M":"Mr. ",$P(VADM(5),"^",1)["F":"Ms. ",1:"")_FIXDNAME_","
- W !!,?RMPRTAB+0
- W "This is to notify you that the items listed below were ordered"
- W !,?RMPRTAB,"for you on "
- W $$FMTE^XLFDT($P(^RMPR(664,RDA,0),U,1),"D")_". Delivery of this equipment is expected"
- W !,?RMPRTAB,$S($P($G(^RMPR(664,RDA,3)),U,2)'="":"on or about "_$$FMTE^XLFDT($P(^RMPR(664,RDA,3),U,2),"D")_".",1:"in 30 days from the order date.")
- W !!,?RMPRTAB,"If you do not receive it within 5 days of the expected date,"
- S LINE="please contact "_RMPREMP_", of my staff, at "_RMPRPHON_"."
- W $$RAP^RMPRUTL1(LINE,RMPRTAB)
- ITEMS NEW DA
- W !
- S RMPRLAST=$P(^RMPR(664,RDA,1,0),U,4) F LP=1:1:RMPRLAST D
- .I $D(RMPRITEM(LP)) W !,?RMPRTAB+3,RMPRITEM(LP)
- .E S RMPRITM=RMPRITM(LP) W !,?RMPRTAB+3,$$ITM^RMPR31U(RMPRITM)
- W !!,?RMPRTAB,"Sincerely,"
- W !!!!!,?RMPRTAB,RMPR("SIG")
- W !,?RMPRTAB,RMPR("SBT")
- W @IOF
- K RMPREMP,RMPRNAME,LINE Q " "
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR4P24 2807 printed Jan 18, 2025@03:34:05 Page 2
- RMPR4P24 ;PHX/HPL-Print patient PC notification letter ;10/31/1994
- +1 ;;3.0;PROSTHETICS;**3,20,55,161**;Feb 09, 1996;Build 2
- +2 ;
- +3 ; ODJ - patch 55 - 1/29/01 - replace hard coded mail route code 121
- +4 ; with call to extrinsic for site param.
- +5 ; see nois AUG-1097-32118
- +6 ;
- EN(RDA) ;SETUP VARIABLES AND PRINT PATIENT NOTIFICATION LETTER
- +1 ;VARIABLE REQUIRED:RDA - ENTRY # IN FILE 664
- +2 NEW VAHOW
- +3 SET NAME=$PIECE(^RMPR(664,RDA,0),U,9)
- SET RMPRINIT=NAME
- SET RMPREMP=$$SIG^RMPR31U(NAME)
- +4 IF $DATA(^VA(200,RMPRINIT,.13))
- SET RMPRPHON=$PIECE(^VA(200,RMPRINIT,.13),U,2)
- +5 IF '$DATA(^VA(200,$PIECE(^RMPR(664,RDA,0),U,9),.13))
- SET RMPRPHON=RMPR("PHONE")
- +6 SET DFN=$PIECE(^RMPR(664,RDA,0),U,2)
- DO ADD^VADPT
- DO DEM^VADPT
- +7 SET RMPRITEM=""
- +8 SET RMPRITM=0
- FOR LP=1:1
- SET RMPRITM=$ORDER(^RMPR(664,RDA,1,RMPRITM))
- if RMPRITM="B"
- QUIT
- SET RMPRITEM(LP)=$PIECE(^RMPR(664,RDA,1,RMPRITM,0),U,2)
- SET RMPRITM(LP)=$PIECE(^RMPR(664,RDA,1,RMPRITM,0),U,1)
- +9 SET HEADING="Department of Veterans Affairs"
- +10 WRITE !!!!!,?IOM-$LENGTH(HEADING)\2,HEADING
- +11 SET RMPRTAB=IOM-$LENGTH(RMPR("NAME"))\2
- WRITE !,?RMPRTAB,RMPR("NAME")
- +12 SET RMPRTAB=IOM-$LENGTH(RMPR("ADD"))\2
- WRITE !,?RMPRTAB,RMPR("ADD")
- +13 SET RMPRTAB=IOM-$LENGTH(RMPR("CITY"))\2
- WRITE !,?RMPRTAB,RMPR("CITY")
- +14 SET RMPRTAB=7
- SET NAME=VADM(1)
- SET FIXDNAME=$$PARS^RMPRUTL1(NAME)
- +15 WRITE !!,?44,$$FMTE^XLFDT(DT,"D")
- +16 SET FIXDNAME=$EXTRACT(FIXDNAME,2,$LENGTH(FIXDNAME)-2)
- +17 WRITE !!,?RMPRTAB,$SELECT($PIECE(VADM(5),U,1)["M":"MR. ",$PIECE(VADM(5),U,1)["F":"MS. ",1:"")_$$UP^XLFSTR(FIXDNAME)
- +18 WRITE ?44,"In reply refer to: ",$PIECE(^DIC(4,RMPR("STA"),99),U,1)_"/"_$$ROU^RMPRUTIL(RMPRSITE),!
- +19 ;display purchase card transaction
- +20 if VAPA(1)'=""
- WRITE ?RMPRTAB,VAPA(1)
- +21 if VAPA(2)'=""
- WRITE ?RMPRTAB,VAPA(2)
- +22 WRITE ?44,"Accounting Symbol ",$PIECE(^RMPR(664,RDA,4),U,5),!
- +23 if VAPA(3)'=""
- WRITE ?RMPRTAB,VAPA(3)
- +24 if VAPA(4)'=""
- WRITE ?RMPRTAB,VAPA(4)_", "_$PIECE(VAPA(5),"^",2)_" "_VAPA(6)
- +25 WRITE ?44,"Veteran: ",VADM(1),!
- +26 ; *161 removed old line which printed SSN
- +27 WRITE !!,?RMPRTAB,"Dear ",$SELECT($PIECE(VADM(5),"^",1)["M":"Mr. ",$PIECE(VADM(5),"^",1)["F":"Ms. ",1:"")_FIXDNAME_","
- +28 WRITE !!,?RMPRTAB+0
- +29 WRITE "This is to notify you that the items listed below were ordered"
- +30 WRITE !,?RMPRTAB,"for you on "
- +31 WRITE $$FMTE^XLFDT($PIECE(^RMPR(664,RDA,0),U,1),"D")_". Delivery of this equipment is expected"
- +32 WRITE !,?RMPRTAB,$SELECT($PIECE($GET(^RMPR(664,RDA,3)),U,2)'="":"on or about "_$$FMTE^XLFDT($PIECE(^RMPR(664,RDA,3),U,2),"D")_".",1:"in 30 days from the order date.")
- +33 WRITE !!,?RMPRTAB,"If you do not receive it within 5 days of the expected date,"
- +34 SET LINE="please contact "_RMPREMP_", of my staff, at "_RMPRPHON_"."
- +35 WRITE $$RAP^RMPRUTL1(LINE,RMPRTAB)
- ITEMS NEW DA
- +1 WRITE !
- +2 SET RMPRLAST=$PIECE(^RMPR(664,RDA,1,0),U,4)
- FOR LP=1:1:RMPRLAST
- Begin DoDot:1
- +3 IF $DATA(RMPRITEM(LP))
- WRITE !,?RMPRTAB+3,RMPRITEM(LP)
- +4 IF '$TEST
- SET RMPRITM=RMPRITM(LP)
- WRITE !,?RMPRTAB+3,$$ITM^RMPR31U(RMPRITM)
- End DoDot:1
- +5 WRITE !!,?RMPRTAB,"Sincerely,"
- +6 WRITE !!!!!,?RMPRTAB,RMPR("SIG")
- +7 WRITE !,?RMPRTAB,RMPR("SBT")
- +8 WRITE @IOF
- +9 KILL RMPREMP,RMPRNAME,LINE
- QUIT " "