source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPOLF2.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1RMPOLF2 ;HIN CIOFO/RVD-CONTINUATION OF RMPOLF1 ;06/22/99
2 ;;3.0;PROSTHETICS;**29**;Feb 09, 1996
3VIEW ;VIEW LETTERS FROM ELIG SCREEN2 UNDER ISSUE FROM STOCK
4 N RMPRDA,DA,RMPRIN
5 Q:$G(DFN)=""!(%=3)
6 S RMPRFF=1 I '$D(^RMPR(665.4,"B",DFN)) G RO1
7 K KILL
8 W !!,"Letters on file:"
9 ;!,?5,"Type",?29,"Employee",?55,"Date or Vendor"
10ASK1 ;SET UP REVERSE LETTER LIST & ASK IF USER WANTS TO VIEW MORE LETTERS
11 D EN^RMPRUTL2
12 S DA=RMPRIN G:$G(DA)'>0 ASK2
13 S RMPRIN=DA D PRINT^RMPOLF1
14MOLET K DA,RMPRDA,RMPRIN
15 S %=2 W !,"Would you like to see more letters" D YN^DICN
16 I %=-1 S KILL=1 Q
17 I %=0 W !,"'YES' will let you review another letter for this patient",!,"'NO' will let you continue the program"
18 I W !,"Enter '^' to exit the correspondence screen totally" G MOLET
19 I %=2 S KILL=1 D RO1 Q
20 I %=1 G ASK1
21 G RO1
22ASK2 ;Q:RMPRIN=-1
23 S %=2 W !,"Do you wish to view a letter" D YN^DICN Q:$D(DTOUT) S:%<0 KILL=1 G:%=2!(%<0) RO1
24 I %=0 W !,"Answer `YES` or `NO`" G ASK2
25 I %=1 G VIEW
26 ;I %=1 S %=3 G VIEW
27ASK3 I %=2 K X R !!,"Enter the number: ",X:DTIME Q:'$T!(X="") Q:X="^" I X>(I-1)!(+X<1)!(X'?1N.N) W !,$C(7),"Enter a number between 1 and ",(I-1)_" or `^` to quit." G ASK3
28 I %=1 I $G(X)'="" I $G(RMPR9VA($G(X)))=""&($G(RMPRDFN)'="") S RMPR9VA($G(X))=RMPRDFN
29 I %=1,$D(^RMPR(665.4,RMPR9VA(+X),0)) S RMPRIN=RMPR9VA(+X),RMPREN=1 D PRINT^RMPOLF1 G VIEW
30RO1 ;K RMPREN S %=2 W !,"Do you wish to create a correspondence letter" D YN^DICN
31 ;I %=1 D CUM^RMPOLF0 Q
32 ;I %=0 W !,"Answer `YES` to create a form letter, `NO` to continue." G RO1
33 ;I %=2 K RMPRBB,RMPRFF,RMPR9ZRO,RMPR9VA(1),RMPR9VA(2)
34 ;S %=3 Q
35 Q
36 ;
37EN4 ;EDIT A SKELETON
38 K DIC S DIC="^RMPR(665.2,",DIC(0)="AEQLM",DLAYGO=665.2 D ^DIC K DLAYGO
39 I +Y<0!($P(Y,U,4)["1") W !!,"SORRY, THIS IS A NON-EDITABLE LETTER" Q
40 S RMPRIN=+Y L +^RMPR(665.2,RMPRIN,0):1 I $T=0 W !,$C(7),?5,"Someone else is Editing this entry!" K RMPRIN Q
41 S DIE="^RMPR(665.2,",DA=RMPRIN,DR=".01;1",DIE("NO^")="" D ^DIE L -^RMPR(665.2,RMPRIN,0) I '$D(DA)!($D(DTOUT))!($D(DUOUT)) Q
42DEN S %=$S($P(^RMPR(665.2,RMPRIN,0),U,2)=1:1,1:2) W !,"Is this a Denial type of letter" D YN^DICN
43 Q:%<0
44 I %=0 G QUES1
45 S $P(^RMPR(665.2,RMPRIN,0),U,2)=$S(%=2:0,%=1:1,1:"")
46 Q
47QUES1 W !,"Enter `YES` if letter is an AMIS Denial" G DEN
48EN3 ;PRINT FORM LETTER
49 I '$D(RMPR("SIG")) D DIV4^RMPRSIT Q:$D(X)
50 D HOME^%ZIS
51 ;CHECK IF IT IS THE ADP FL 10-90
52 K DIC S DIC="^RMPR(665.2,",DIC(0)="AEQM" D ^DIC Q:+Y<0
53 S RMPRIN=+Y K DIC
54 ;check if it is the ADP FL 10-90
55PR S DIWF="^RMPR(665.2,RMPRIN,1,",DIWF(1)=665.2,BY="@NUMBER",FR=RMPRIN,TO=RMPRIN D EN2^DIWF
56 Q
57 ;
58SET K DIC S DIC="^RMPR(665.4,",DIC(0)="L",X=DFN,DLAYGO=665.4 K DD,DO,DINUM D FILE^DICN K DLAYGO
59 G:Y<0 EXIT^RMPOLF1
60 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
61 S %X="^TMP($J,""DW"",",%Y="^RMPR(665.4,+Y,1," D %XY^%RCR
62 G PRINT^RMPOLF1
63 Q
64 ;
65SETALL K DIC S DIC="^RMPR(665.4,",DIC(0)="L",X=DFN,DLAYGO=665.4 K DD,DO,DINUM D FILE^DICN K DLAYGO
66 G:Y<0 EXIT^RMPOLF1
67 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
68 S %X="^TMP($J,""DW"",",%Y="^RMPR(665.4,+Y,1," D %XY^%RCR
69 S ^TMP("RL",$J,1,RMPRIN)=DFN
70 Q
71WRITE S:$G(RMPR9ZRO)'=""&(RO="") RO=RMPR9ZRO
72 I I#15=0 S DIR(0)="FAOU^1:245",DIR("A")="End of page: select a letter by number or enter'^' to continue listining" D I $G(X)="^" Q
73 .D ^DIR
74 .I $G(X)="" Q
75 .I $G(X)>0&($G(RO)>0&($G(X)<(RO+1))) S DA=^TMP($J,"RMPR",RO) W !,"***",DA Q
76 W !,I_" ",?4,$S($D(^RMPR(665.2,+$P(^RMPR(665.4,^TMP($J,"RMPR",RO),0),U,2),0)):$E($P(^(0),U,1),1,20),1:"UNKNOWN")
77 S:$D(^RMPR(665.4,^TMP($J,"RMPR",RO),2)) RMPR2=$P(^RMPR(665.4,^TMP($J,"RMPR",RO),2),U,1)
78 ;W ?27,$S($D(^VA(200,+$P(^RMPR(665.4,^TMP($J,"RMPR",RO),0),U,4),0)):$E($P(^(0),U),1,15),1:"")
79 S RMPRPP=$G(^VA(200,+$P(^RMPR(665.4,^TMP($J,"RMPR",RO),0),U,4),0))'="" W ?27,$E($P(^(0),U),1,15) K RMPRPP
80 S Y=$S($P(^RMPR(665.4,^TMP($J,"RMPR",RO),0),U,3):$P(^RMPR(665.4,^TMP($J,"RMPR",RO),0),U,3),$D(RMPR2):$P(^PRC(440,RMPR2,0),U,1),1:"") D DD^%DT W ?55,$E(Y,1,24) S RMPR9VA(I)=^TMP($J,"RMPR",RO)
81 Q
Note: See TracBrowser for help on using the repository browser.