- RMPOLF0A ;HIN CIOFO/RVD-DRIVER FOR HO LETTERS(ALL) ;06/28/99
- ;;3.0;PROSTHETICS;**29,55,115,159,160**;Feb 09, 1996;Build 14
- ;
- ; ODJ - patch 55 - 29/1/01 - replace 121 hard coded mail code with call
- ; to site param. extrinsic (AUG-1097-32118)
- ;
- D HOME^%ZIS S RMPRIN=0
- S RMPRTFLG=1
- S Y=DT D DD^%DT S NAME=Y D TRANS^RMPRUTL1 S (RMPODT,RMPODATE)=RMPRNAME
- K ZTSAVE D FULL^VALM1
- S JOBTIM=$J_$P($H,",",2) K ^XTMP("RL",JOBTIM)
- D NOW^%DTC S RMSTART=%,^XTMP("RL",JOBTIM,0)=$$FMADD^XLFDT(RMSTART,5)_"^"_RMSTART
- M ^XTMP("RL",JOBTIM)=^TMP($J) K ^TMP($J)
- PRINT ; print ALL patient letters
- S %ZIS="MQ" K IOP D ^%ZIS G EXIT:POP=1
- I $D(IO("Q")) D D ^%ZTLOAD G EXIT
- . S ZTRTN="QUED^RMPOLF0A",ZTDESC="PRINT ALL HO LETTERS"
- . K ZTSAVE,IO("Q") S ZTIO=ION,(ZTSAVE("RMPOXITE"),ZTSAVE("RMPOLCD"),ZTSAVE("JOBTIM"),ZTSAVE("RMPODT"),ZTSAVE("RMPODATE"),ZTSAVE("RMPRNAME"))=""
- U IO
- ;
- QUED ;
- S (RMBLNK,RMPONAM)="",RMQUIT=0 S:'$D(ZTQUEUED) RMIOST=IOST,RMIO=ION
- F S RMPONAM=$O(^XTMP("RL",JOBTIM,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM)) Q:RMPONAM=""!$G(RMQUIT) D CUM
- F RI=0:0 S RI=$O(^XTMP("RL",JOBTIM,1,RI)) Q:RI'>0 S RMDFN=^XTMP("RL",JOBTIM,1,RI) D
- .I RMPOLCD="A" S $P(^RMPR(665,RMDFN,"RMPOA"),U,9)=DT,$P(^("RMPOA"),U,10)="P" K ^RMPR(669.9,RMPOXITE,"RMPOXBAT1") S ^RMPR(669.9,RMPOXITE,"RMPOXBAT1",0)="^669.9002P^^^"
- .I RMPOLCD="B" S $P(^RMPR(665,RMDFN,"RMPOA"),U,11)=DT,$P(^("RMPOA"),U,12)="P" K ^RMPR(669.9,RMPOXITE,"RMPOXBAT2") S ^RMPR(669.9,RMPOXITE,"RMPOXBAT2",0)="^669.972P^^^"
- .I RMPOLCD="C" S $P(^RMPR(665,RMDFN,"RMPOA"),U,13)=DT,$P(^("RMPOA"),U,14)="P" K ^RMPR(669.9,RMPOXITE,"RMPOXBAT3") S ^RMPR(669.9,RMPOXITE,"RMPOXBAT3",0)="^669.974P^^^"
- ;
- EXIT K LFNS,LFN,ZI,RTN,DIR,RMLET,RMPRTFLG,RMPRIN,RMIO,RMIOST,RMION,RMPONAM,HOLDJB,EOP
- K RMDAT,DFN,RMDA,RMPRFA,RMDFN,RI
- K %,%X,%Y,%ZIS,DA,DIK,POP,RMSTART,RV,TAB,VADM(5),X,ZTIO,ZTSK
- M ^TMP($J)=^XTMP("RL",JOBTIM) K ^TMP("RL",$J)
- K ^TMP($J,RMPOXITE,"RMPOLST",RMPOLCD)
- D ^%ZISC I $D(ZTQUEUED) S ZTREQ="@" K ^XTMP("RL",JOBTIM) Q
- K JOBTIM
- D CLEAN^VALM10,INIT^RMPOLT,RE^VALM4
- S VALMBCK="R"
- Q
- ;
- CUM ;
- S RMDAT=^XTMP("RL",JOBTIM,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM)
- S RMPOLTR=$P(RMDAT,U,1)
- S DFN=$P(RMDAT,U,2)
- S RMDA=$P(RMDAT,U,3)
- S RMPRFA=RMPOLTR,RMPRTFLG=1
- S RMREC=^XTMP("RL",JOBTIM,RMPOXITE,"RMPODEMO",DFN)
- S RMPORX=$P(RMREC,U,6) S:RMPORX="" RMPORX="Not on file"
- S RMPORXDT=$P(RMREC,U,4)
- I RMPORXDT="" S RMPORXDT="n/a"
- E S Y=RMPORXDT X ^DD("DD") S RMPORXDT=Y
- D DEM^VADPT,ADD^VADPT
- F RI=1:1:21 S ^TMP($J,"DW",RI,0)=" "
- S RMPRHED=$G(^XTMP("RL",JOBTIM,RMPOXITE,"HEADER",RMPOLTR))
- I 'RMPRHED G HEADER
- S ^TMP($J,"DW",1,0)="|SETTAB(""C"")|"
- S ^TMP($J,"DW",2,0)="|TAB|Department of Veterans Affairs"
- S NAME=$P(^RMPR(669.9,RMPOXITE,2),U,4) I NAME]"" S NAME=$S($D(^DIC(5,NAME)):$P(^DIC(5,NAME,0),U),1:"STATE") S RMFXN=$$PARS^RMPRUTL1(NAME)
- S ^TMP($J,"DW",3,0)="|TAB|"_$P(^RMPR(669.9,RMPOXITE,0),U)
- S ^TMP($J,"DW",4,0)="|TAB|"_$P(^RMPR(669.9,RMPOXITE,2),U,2)
- S ^TMP($J,"DW",5,0)="|TAB|"_$P(^RMPR(669.9,RMPOXITE,2),U,3)_", "_RMFXN_" "_$P(^RMPR(669.9,RMPOXITE,2),U,5) K RMFXN
- S ^TMP($J,"DW",9,0)="|SETTAB(5,50)||TAB|"_RMPODT
- S STATNID=$P(^RMPR(669.9,RMPOXITE,0),U,2) I $D(^DIC(4,STATNID,99)) S STATNID=$P(^DIC(4,STATNID,99),U)
- S ^TMP($J,"DW",11,0)="|TAB|"_$P(VADM(1),",",2)_" "_$P(VADM(1),",",1)_"|TAB|In Reply Refer To: "_STATNID_"/"_$$ROU^RMPRUTIL(RMPOXITE)
- K STATNID
- S ^TMP($J,"DW",12,0)="|TAB|"_VAPA(1)
- I VAPA(2)]"" S ^TMP($J,"DW",13,0)="|TAB|"_VAPA(2)_"|TAB|"_VADM(1),^TMP($J,"DW",14,0)="|TAB|"_VAPA(4)_","_" "_$P(VAPA(5),U,2)_" "_VAPA(6)
- E S ^TMP($J,"DW",13,0)="|TAB|"_VAPA(4)_","_" "_$P(VAPA(5),U,2)_" "_VAPA(6)_"|TAB|"_VADM(1)
- S ^TMP($J,"DW",16,0)="|TAB|"_RMBLNK_"|TAB|Current Home Oxygen Rx#: "_RMPORX
- S ^TMP($J,"DW",17,0)="|TAB|"_RMBLNK_"|TAB|Rx Expiration Date: "_RMPORXDT
- ;
- W:$G(EOP) @IOF
- W !!,?23,"Department of Veterans Affairs"
- S NAME=$P(^RMPR(669.9,RMPOXITE,2),U,4) I NAME]"" S NAME=$S($D(^DIC(5,NAME)):$P(^DIC(5,NAME,0),U),1:"STATE") S RMFXN=$$PARS^RMPRUTL1(NAME)
- S HEADW=$P(^RMPR(669.9,RMPOXITE,0),U) W !,?(80-$L(HEADW)/2),HEADW
- S HEADW=$P(^RMPR(669.9,RMPOXITE,2),U,2) W !,?(80-$L(HEADW)/2),HEADW
- S HEADW=$P(^RMPR(669.9,RMPOXITE,2),U,3)_", "_RMFXN_" "_$P(^RMPR(669.9,RMPOXITE,2),U,5) W !,?(80-$L(HEADW)/2),HEADW K RMFXN,HEADW
- W !!!,RMPODT
- S STATNID=$P(^RMPR(669.9,RMPOXITE,0),U,2) I $D(^DIC(4,STATNID,99)) S STATNID=$P(^DIC(4,STATNID,99),U)
- W !!,$P(VADM(1),",",2)_" "_$P(VADM(1),",",1),?43,"In Reply Refer To: "_STATNID_"/"_$$ROU^RMPRUTIL(RMPOXITE)
- K STATNID
- W !,VAPA(1)
- I VAPA(2)]"" W !,VAPA(2),?43,VADM(1),!,VAPA(4)_","_" "_$P(VAPA(5),U,2)_" "_VAPA(6)
- E W !,VAPA(4)_","_" "_$P(VAPA(5),U,2)_" "_VAPA(6),?43,VADM(1)
- W !!,?43,DFN
- W !,?43,"Current Home Oxygen Rx#: "_RMPORX
- W !,?43,"Rx Expiration Date: "_RMPORXDT
- ;
- S NAME=$P(VADM(1),",")
- I $P(NAME," ",2)?1A.A D
- .S NAME1=NAME,NAME=$P(NAME," ",1) D TRANS^RMPRUTL1 S RMPRNAM1=RMPRNAME,NAME=NAME1,NAME=$P(NAME," ",2) D TRANS^RMPRUTL1 S RMPRNAM2=RMPRNAME,RMPRNAME=RMPRNAM1_" "_RMPRNAM2
- E D TRANS^RMPRUTL1
- NAME ;
- S RMPRNAME=$P(RMPRNAME," ",1,2) K RMPRVIEW,RMPRPRIN
- I $P(VADM(5),U)["M" W !!,"Dear Mr. "_RMPRNAME_":" S ^TMP($J,"DW",19,0)="|TAB|"_"Dear Mr. "_RMPRNAME_":"
- E W !!,"Dear Ms. "_RMPRNAME_":" S ^TMP($J,"DW",19,0)="|TAB|"_"Dear Ms. "_RMPRNAME_":"
- W !!
- S RV=21 F RI=0:0 S RI=$O(^RMPR(665.2,RMPRFA,1,RI)) Q:RI'>0 Q:^(RI,0)'=" "
- S RI=RI-1 F S RI=$O(^RMPR(665.2,RMPRFA,1,RI)) Q:RI'>0 S TAB=$S($P(^RMPR(665.2,RMPRFA,1,RI,0),U)["|TAB|":"",1:"|TAB|") S ^TMP($J,"DW",RV,0)=TAB_^(0),RV=RV+1
- S RI=0 F S RI=$O(^RMPR(665.2,RMPRFA,1,RI)) Q:RI'>0 D
- . ;I $Y>60 W @IOF W !!!!!!
- . W !,$G(^RMPR(665.2,RMPRFA,1,RI,0))
- S EOP=1
- SETALL K DIC S DIC="^RMPR(665.4,",DIC(0)="L",X=DFN,DLAYGO=665.4 K DD,DO,DINUM D FILE^DICN K DLAYGO
- G:Y<0 EXIT^RMPOLF1
- S RMPRIN=+Y,$P(^RMPR(665.4,RMPRIN,0),U,2)=RMPRFA,$P(^(0),U,3)=DT,$P(^(0),U,4)=DUZ,$P(^RMPR(665.4,RMPRIN,0),U,5)=$P(^RMPR(665.2,RMPRFA,0),U,2),$P(^RMPR(665.4,RMPRIN,0),U,6)=RMPOXITE S DIK=DIC,DA=RMPRIN D IX1^DIK
- S %X="^TMP($J,""DW"",",%Y="^RMPR(665.4,+Y,1," D %XY^%RCR
- S ^TMP("RL",JOBTIM,1,RMPRIN)=DFN
- Q
- QUEUE(ZTDESC,ZTRTN,ZTSAVE) ; Queue print
- D ^%ZTLOAD
- I '$D(ZTSK) W !!,?5,"Report Cancelled!",! Q 0
- E W !!,?5,"Print queued!",! Q 1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOLF0A 6329 printed Apr 23, 2025@18:45:30 Page 2
- RMPOLF0A ;HIN CIOFO/RVD-DRIVER FOR HO LETTERS(ALL) ;06/28/99
- +1 ;;3.0;PROSTHETICS;**29,55,115,159,160**;Feb 09, 1996;Build 14
- +2 ;
- +3 ; ODJ - patch 55 - 29/1/01 - replace 121 hard coded mail code with call
- +4 ; to site param. extrinsic (AUG-1097-32118)
- +5 ;
- +6 DO HOME^%ZIS
- SET RMPRIN=0
- +7 SET RMPRTFLG=1
- +8 SET Y=DT
- DO DD^%DT
- SET NAME=Y
- DO TRANS^RMPRUTL1
- SET (RMPODT,RMPODATE)=RMPRNAME
- +9 KILL ZTSAVE
- DO FULL^VALM1
- +10 SET JOBTIM=$JOB_$PIECE($HOROLOG,",",2)
- KILL ^XTMP("RL",JOBTIM)
- +11 DO NOW^%DTC
- SET RMSTART=%
- SET ^XTMP("RL",JOBTIM,0)=$$FMADD^XLFDT(RMSTART,5)_"^"_RMSTART
- +12 MERGE ^XTMP("RL",JOBTIM)=^TMP($JOB)
- KILL ^TMP($JOB)
- PRINT ; print ALL patient letters
- +1 SET %ZIS="MQ"
- KILL IOP
- DO ^%ZIS
- if POP=1
- GOTO EXIT
- +2 IF $DATA(IO("Q"))
- Begin DoDot:1
- +3 SET ZTRTN="QUED^RMPOLF0A"
- SET ZTDESC="PRINT ALL HO LETTERS"
- +4 KILL ZTSAVE,IO("Q")
- SET ZTIO=ION
- SET (ZTSAVE("RMPOXITE"),ZTSAVE("RMPOLCD"),ZTSAVE("JOBTIM"),ZTSAVE("RMPODT"),ZTSAVE("RMPODATE"),ZTSAVE("RMPRNAME"))=""
- End DoDot:1
- DO ^%ZTLOAD
- GOTO EXIT
- +5 USE IO
- +6 ;
- QUED ;
- +1 SET (RMBLNK,RMPONAM)=""
- SET RMQUIT=0
- if '$DATA(ZTQUEUED)
- SET RMIOST=IOST
- SET RMIO=ION
- +2 FOR
- SET RMPONAM=$ORDER(^XTMP("RL",JOBTIM,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM))
- if RMPONAM=""!$GET(RMQUIT)
- QUIT
- DO CUM
- +3 FOR RI=0:0
- SET RI=$ORDER(^XTMP("RL",JOBTIM,1,RI))
- if RI'>0
- QUIT
- SET RMDFN=^XTMP("RL",JOBTIM,1,RI)
- Begin DoDot:1
- +4 IF RMPOLCD="A"
- SET $PIECE(^RMPR(665,RMDFN,"RMPOA"),U,9)=DT
- SET $PIECE(^("RMPOA"),U,10)="P"
- KILL ^RMPR(669.9,RMPOXITE,"RMPOXBAT1")
- SET ^RMPR(669.9,RMPOXITE,"RMPOXBAT1",0)="^669.9002P^^^"
- +5 IF RMPOLCD="B"
- SET $PIECE(^RMPR(665,RMDFN,"RMPOA"),U,11)=DT
- SET $PIECE(^("RMPOA"),U,12)="P"
- KILL ^RMPR(669.9,RMPOXITE,"RMPOXBAT2")
- SET ^RMPR(669.9,RMPOXITE,"RMPOXBAT2",0)="^669.972P^^^"
- +6 IF RMPOLCD="C"
- SET $PIECE(^RMPR(665,RMDFN,"RMPOA"),U,13)=DT
- SET $PIECE(^("RMPOA"),U,14)="P"
- KILL ^RMPR(669.9,RMPOXITE,"RMPOXBAT3")
- SET ^RMPR(669.9,RMPOXITE,"RMPOXBAT3",0)="^669.974P^^^"
- End DoDot:1
- +7 ;
- EXIT KILL LFNS,LFN,ZI,RTN,DIR,RMLET,RMPRTFLG,RMPRIN,RMIO,RMIOST,RMION,RMPONAM,HOLDJB,EOP
- +1 KILL RMDAT,DFN,RMDA,RMPRFA,RMDFN,RI
- +2 KILL %,%X,%Y,%ZIS,DA,DIK,POP,RMSTART,RV,TAB,VADM(5),X,ZTIO,ZTSK
- +3 MERGE ^TMP($JOB)=^XTMP("RL",JOBTIM)
- KILL ^TMP("RL",$JOB)
- +4 KILL ^TMP($JOB,RMPOXITE,"RMPOLST",RMPOLCD)
- +5 DO ^%ZISC
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- KILL ^XTMP("RL",JOBTIM)
- QUIT
- +6 KILL JOBTIM
- +7 DO CLEAN^VALM10
- DO INIT^RMPOLT
- DO RE^VALM4
- +8 SET VALMBCK="R"
- +9 QUIT
- +10 ;
- CUM ;
- +1 SET RMDAT=^XTMP("RL",JOBTIM,RMPOXITE,"RMPOLST",RMPOLCD,RMPONAM)
- +2 SET RMPOLTR=$PIECE(RMDAT,U,1)
- +3 SET DFN=$PIECE(RMDAT,U,2)
- +4 SET RMDA=$PIECE(RMDAT,U,3)
- +5 SET RMPRFA=RMPOLTR
- SET RMPRTFLG=1
- +6 SET RMREC=^XTMP("RL",JOBTIM,RMPOXITE,"RMPODEMO",DFN)
- +7 SET RMPORX=$PIECE(RMREC,U,6)
- if RMPORX=""
- SET RMPORX="Not on file"
- +8 SET RMPORXDT=$PIECE(RMREC,U,4)
- +9 IF RMPORXDT=""
- SET RMPORXDT="n/a"
- +10 IF '$TEST
- SET Y=RMPORXDT
- XECUTE ^DD("DD")
- SET RMPORXDT=Y
- +11 DO DEM^VADPT
- DO ADD^VADPT
- +12 FOR RI=1:1:21
- SET ^TMP($JOB,"DW",RI,0)=" "
- +1 SET RMPRHED=$GET(^XTMP("RL",JOBTIM,RMPOXITE,"HEADER",RMPOLTR))
- +2 IF 'RMPRHED
- GOTO HEADER
- +3 SET ^TMP($JOB,"DW",1,0)="|SETTAB(""C"")|"
- +4 SET ^TMP($JOB,"DW",2,0)="|TAB|Department of Veterans Affairs"
- +5 SET NAME=$PIECE(^RMPR(669.9,RMPOXITE,2),U,4)
- IF NAME]""
- SET NAME=$SELECT($DATA(^DIC(5,NAME)):$PIECE(^DIC(5,NAME,0),U),1:"STATE")
- SET RMFXN=$$PARS^RMPRUTL1(NAME)
- +6 SET ^TMP($JOB,"DW",3,0)="|TAB|"_$PIECE(^RMPR(669.9,RMPOXITE,0),U)
- +7 SET ^TMP($JOB,"DW",4,0)="|TAB|"_$PIECE(^RMPR(669.9,RMPOXITE,2),U,2)
- +8 SET ^TMP($JOB,"DW",5,0)="|TAB|"_$PIECE(^RMPR(669.9,RMPOXITE,2),U,3)_", "_RMFXN_" "_$PIECE(^RMPR(669.9,RMPOXITE,2),U,5)
- KILL RMFXN
- +1 SET ^TMP($JOB,"DW",9,0)="|SETTAB(5,50)||TAB|"_RMPODT
- +2 SET STATNID=$PIECE(^RMPR(669.9,RMPOXITE,0),U,2)
- IF $DATA(^DIC(4,STATNID,99))
- SET STATNID=$PIECE(^DIC(4,STATNID,99),U)
- +3 SET ^TMP($JOB,"DW",11,0)="|TAB|"_$PIECE(VADM(1),",",2)_" "_$PIECE(VADM(1),",",1)_"|TAB|In Reply Refer To: "_STATNID_"/"_$$ROU^RMPRUTIL(RMPOXITE)
- +4 KILL STATNID
- +5 SET ^TMP($JOB,"DW",12,0)="|TAB|"_VAPA(1)
- +6 IF VAPA(2)]""
- SET ^TMP($JOB,"DW",13,0)="|TAB|"_VAPA(2)_"|TAB|"_VADM(1)
- SET ^TMP($JOB,"DW",14,0)="|TAB|"_VAPA(4)_","_" "_$PIECE(VAPA(5),U,2)_" "_VAPA(6)
- +7 IF '$TEST
- SET ^TMP($JOB,"DW",13,0)="|TAB|"_VAPA(4)_","_" "_$PIECE(VAPA(5),U,2)_" "_VAPA(6)_"|TAB|"_VADM(1)
- +8 SET ^TMP($JOB,"DW",16,0)="|TAB|"_RMBLNK_"|TAB|Current Home Oxygen Rx#: "_RMPORX
- +9 SET ^TMP($JOB,"DW",17,0)="|TAB|"_RMBLNK_"|TAB|Rx Expiration Date: "_RMPORXDT
- +10 ;
- +1 if $GET(EOP)
- WRITE @IOF
- +2 WRITE !!,?23,"Department of Veterans Affairs"
- +3 SET NAME=$PIECE(^RMPR(669.9,RMPOXITE,2),U,4)
- IF NAME]""
- SET NAME=$SELECT($DATA(^DIC(5,NAME)):$PIECE(^DIC(5,NAME,0),U),1:"STATE")
- SET RMFXN=$$PARS^RMPRUTL1(NAME)
- +4 SET HEADW=$PIECE(^RMPR(669.9,RMPOXITE,0),U)
- WRITE !,?(80-$LENGTH(HEADW)/2),HEADW
- +5 SET HEADW=$PIECE(^RMPR(669.9,RMPOXITE,2),U,2)
- WRITE !,?(80-$LENGTH(HEADW)/2),HEADW
- +6 SET HEADW=$PIECE(^RMPR(669.9,RMPOXITE,2),U,3)_", "_RMFXN_" "_$PIECE(^RMPR(669.9,RMPOXITE,2),U,5)
- WRITE !,?(80-$LENGTH(HEADW)/2),HEADW
- KILL RMFXN,HEADW
- +1 WRITE !!!,RMPODT
- +2 SET STATNID=$PIECE(^RMPR(669.9,RMPOXITE,0),U,2)
- IF $DATA(^DIC(4,STATNID,99))
- SET STATNID=$PIECE(^DIC(4,STATNID,99),U)
- +3 WRITE !!,$PIECE(VADM(1),",",2)_" "_$PIECE(VADM(1),",",1),?43,"In Reply Refer To: "_STATNID_"/"_$$ROU^RMPRUTIL(RMPOXITE)
- +4 KILL STATNID
- +5 WRITE !,VAPA(1)
- +6 IF VAPA(2)]""
- WRITE !,VAPA(2),?43,VADM(1),!,VAPA(4)_","_" "_$PIECE(VAPA(5),U,2)_" "_VAPA(6)
- +7 IF '$TEST
- WRITE !,VAPA(4)_","_" "_$PIECE(VAPA(5),U,2)_" "_VAPA(6),?43,VADM(1)
- +8 WRITE !!,?43,DFN
- +9 WRITE !,?43,"Current Home Oxygen Rx#: "_RMPORX
- +10 WRITE !,?43,"Rx Expiration Date: "_RMPORXDT
- +11 ;
- +12 SET NAME=$PIECE(VADM(1),",")
- +13 IF $PIECE(NAME," ",2)?1A.A
- Begin DoDot:1
- +14 SET NAME1=NAME
- SET NAME=$PIECE(NAME," ",1)
- DO TRANS^RMPRUTL1
- SET RMPRNAM1=RMPRNAME
- SET NAME=NAME1
- SET NAME=$PIECE(NAME," ",2)
- DO TRANS^RMPRUTL1
- SET RMPRNAM2=RMPRNAME
- SET RMPRNAME=RMPRNAM1_" "_RMPRNAM2
- End DoDot:1
- +15 IF '$TEST
- DO TRANS^RMPRUTL1
- NAME ;
- +1 SET RMPRNAME=$PIECE(RMPRNAME," ",1,2)
- KILL RMPRVIEW,RMPRPRIN
- +2 IF $PIECE(VADM(5),U)["M"
- WRITE !!,"Dear Mr. "_RMPRNAME_":"
- SET ^TMP($JOB,"DW",19,0)="|TAB|"_"Dear Mr. "_RMPRNAME_":"
- +3 IF '$TEST
- WRITE !!,"Dear Ms. "_RMPRNAME_":"
- SET ^TMP($JOB,"DW",19,0)="|TAB|"_"Dear Ms. "_RMPRNAME_":"
- +4 WRITE !!
- +5 SET RV=21
- FOR RI=0:0
- SET RI=$ORDER(^RMPR(665.2,RMPRFA,1,RI))
- if RI'>0
- QUIT
- if ^(RI,0)'=" "
- QUIT
- +6 SET RI=RI-1
- FOR
- SET RI=$ORDER(^RMPR(665.2,RMPRFA,1,RI))
- if RI'>0
- QUIT
- SET TAB=$SELECT($PIECE(^RMPR(665.2,RMPRFA,1,RI,0),U)["|TAB|":"",1:"|TAB|")
- SET ^TMP($JOB,"DW",RV,0)=TAB_^(0)
- SET RV=RV+1
- +7 SET RI=0
- FOR
- SET RI=$ORDER(^RMPR(665.2,RMPRFA,1,RI))
- if RI'>0
- QUIT
- Begin DoDot:1
- +8 ;I $Y>60 W @IOF W !!!!!!
- +9 WRITE !,$GET(^RMPR(665.2,RMPRFA,1,RI,0))
- End DoDot:1
- +10 SET EOP=1
- SETALL KILL DIC
- SET DIC="^RMPR(665.4,"
- SET DIC(0)="L"
- SET X=DFN
- SET DLAYGO=665.4
- KILL DD,DO,DINUM
- DO FILE^DICN
- KILL DLAYGO
- +1 if Y<0
- GOTO EXIT^RMPOLF1
- +2 SET RMPRIN=+Y
- SET $PIECE(^RMPR(665.4,RMPRIN,0),U,2)=RMPRFA
- SET $PIECE(^(0),U,3)=DT
- SET $PIECE(^(0),U,4)=DUZ
- SET $PIECE(^RMPR(665.4,RMPRIN,0),U,5)=$PIECE(^RMPR(665.2,RMPRFA,0),U,2)
- SET $PIECE(^RMPR(665.4,RMPRIN,0),U,6)=RMPOXITE
- SET DIK=DIC
- SET DA=RMPRIN
- DO IX1^DIK
- +3 SET %X="^TMP($J,""DW"","
- SET %Y="^RMPR(665.4,+Y,1,"
- DO %XY^%RCR
- +4 SET ^TMP("RL",JOBTIM,1,RMPRIN)=DFN
- +5 QUIT
- QUEUE(ZTDESC,ZTRTN,ZTSAVE) ; Queue print
- +1 DO ^%ZTLOAD
- +2 IF '$DATA(ZTSK)
- WRITE !!,?5,"Report Cancelled!",!
- QUIT 0
- +3 IF '$TEST
- WRITE !!,?5,"Print queued!",!
- QUIT 1
- +4 QUIT
