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 Nov 22, 2024@17:42:56 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 " "
