| [613] | 1 | RMPRHIS ;PHX/RFM-ADD HISTORICAL DATA ;8/29/1994
|
|---|
| 2 | ;;3.0;PROSTHETICS;**19,45,90**;Feb 09, 1996
|
|---|
| 3 | K RMPRDFN,RMPRSSN,RMPRNAM,RMPRDOB,DIR D HOME^%ZIS S RMPRF=""
|
|---|
| 4 | W @IOF D DIV4^RMPRSIT G:$D(X) EXIT^RMPRHISL D:'$D(RMPRHIS) GETPAT^RMPRUTIL G:'$D(RMPRDFN) EXIT^RMPRHISL
|
|---|
| 5 | VIEW D ^RMPRPAT I $D(RMPRKILL) W !,$C(7),"Deleted..." G EXIT^RMPRHISL
|
|---|
| 6 | RES ;ADDS ANOTHER ITEM FOR HISTORICAL DATA
|
|---|
| 7 | S CK="W:$D(DUOUT) @IOF,$C(7),!!?28,""Deleted..."" H 3 W:$D(DUOUT) @IOF G:$D(DUOUT) RES^RMPRHIS G:$D(DIRUT) EXIT^RMPRHISL"
|
|---|
| 8 | K R1,DA,DD,DIC,PRC,X,Y
|
|---|
| 9 | S R1(0)=DT_U_RMPRDFN,$P(R1(0),U,10)=RMPR("STA"),$P(R1(0),U,15)="*",$P(R1(0),U,13)=13,$P(R1(0),U,27)=DUZ,R1("AM")=""
|
|---|
| 10 | ;DISPLAY VARIABLE
|
|---|
| 11 | S (R3("D"),R4("D"))="",RMPRHISD=1
|
|---|
| 12 | 1 ;ENTRY POINT TO EDIT AN ITEM
|
|---|
| 13 | W @IOF
|
|---|
| 14 | W !?30,RMPRNAM,! S:$P(R1(0),U,3) %DT("B")=$P(R3("D"),U,3) S %DT("A")="DATE OF REQUEST: ",%DT="AEXP" D ^%DT G:X="" ^RMPRHIS G:X="^"&$P(R3("D"),U,3) LIST^RMPRHISL G:X="^" EXIT^RMPRHISL
|
|---|
| 15 | S:Y>0 $P(R1(0),U,3)=Y D DD^%DT S $P(R3("D"),U,3)=Y
|
|---|
| 16 | S DIR("?")="Enter V for VA or C for Commercial"
|
|---|
| 17 | LI S DIR(0)="SBO^V:VA;C:COMMERCIAL"
|
|---|
| 18 | S DIR("A")="Select VA or COMMERCIAL SOURCE"
|
|---|
| 19 | S:$P(R3("D"),U,14)?.A&($P(R3("D"),U,14)'="") DIR("B")=$P(R3("D"),U,14)
|
|---|
| 20 | D ^DIR
|
|---|
| 21 | I $P(R3("D"),U,14)?1A.A&($D(DUOUT)) K DIR G LIST^RMPRHISL
|
|---|
| 22 | G:$D(DTOUT) EXIT^RMPRHISL
|
|---|
| 23 | G:X=""!($D(DUOUT)) ^RMPRHIS
|
|---|
| 24 | G:$D(DIRUT) EXIT^RMPRHISL S $P(R1(0),U,14)=Y K DIR
|
|---|
| 25 | S $P(R3("D"),U,14)=$S(Y="C":"COMMERCIAL",Y="V":"VA",1:"")
|
|---|
| 26 | 2 ;
|
|---|
| 27 | S DIC=661,DIC(0)="AEQM",DIC("A")="ITEM: "
|
|---|
| 28 | S:$P(R1(0),U,6) DIC("B")=$P(R1(0),U,6)
|
|---|
| 29 | D ^DIC
|
|---|
| 30 | I $P(R3("D"),U,6)'=""&$D(DUOUT) K DIC G LIST^RMPRHISL
|
|---|
| 31 | X:$D(DUOUT) CK Q:'$D(R1(0))
|
|---|
| 32 | G:(+Y'>0)&($D(DTOUT)) EXIT^RMPRHISL
|
|---|
| 33 | I +Y'>0 W !!,?5,$C(7),"This is a required response. Enter '^' to exit",! G 2
|
|---|
| 34 | S $P(R1(0),U,6)=+Y,$P(R3("D"),U,6)=$P(Y,U,2) K DIC
|
|---|
| 35 | V ;
|
|---|
| 36 | S DIC=440,DIC(0)="AEQM",DIC("A")="VENDOR: "
|
|---|
| 37 | S:$P(R1(0),U,9) DIC("B")=$P(R1(0),U,9)
|
|---|
| 38 | D ^DIC
|
|---|
| 39 | I $P(R3("D"),U,9)'=""&$D(DUOUT) K DIC G LIST^RMPRHISL
|
|---|
| 40 | X:$D(DUOUT) CK Q:'$D(R1(0))
|
|---|
| 41 | G:(+Y'>0)&($D(DTOUT)) EXIT^RMPRHISL
|
|---|
| 42 | I +Y'>0 W !!,?5,$C(7),"This is a required response. Enter '^' to exit",! G V
|
|---|
| 43 | S $P(R1(0),U,9)=+Y,$P(R3("D"),U,9)=$P(Y,U,2) K DIC
|
|---|
| 44 | W ! S DIR(0)="660,2"
|
|---|
| 45 | S:$P(R1(0),U,4)?.E&($P(R3("D"),U,4)'="") DIR("B")=$P(R3("D"),U,4)
|
|---|
| 46 | D ^DIR
|
|---|
| 47 | I $P(R3("D"),U,4)'=""&($D(DUOUT)) K DIR G LIST^RMPRHISL
|
|---|
| 48 | X:$D(DIRUT) CK Q:'$D(R1(0)) S $P(R1(0),U,4)=Y K DIR
|
|---|
| 49 | S $P(R3("D"),U,4)=$S(Y="I":"INITIAL ISSUE",Y="X":"REPAIR",Y="R":"REPLACE",Y="S":"SPARE",Y=5:"RENTAL",1:"")
|
|---|
| 50 | S DIR(0)="660,62"
|
|---|
| 51 | S:$P(R1("AM"),U,3)?1N.N DIR("B")=$P(R4("D"),U,3) D ^DIR G:$P(R1("AM"),U,3)'=""&($D(DUOUT)) LIST^RMPRHISL X:$D(DIRUT) CK Q:'$D(R1(0))
|
|---|
| 52 | S $P(R1("AM"),U,3)=Y
|
|---|
| 53 | S $P(R4("D"),U,3)=$S(Y=1:"SC/OP",Y=2:"SC/IP",Y=3:"NSC/IP",Y=4:"NSC/OP",1:"")
|
|---|
| 54 | K DIR
|
|---|
| 55 | I Y<4 S $P(R1("AM"),U,4)="",$P(R4("D"),U,4)="" G ^RMPRHISL
|
|---|
| 56 | I Y=4 S DIR(0)="660,63" S:$P(R1("AM"),U,4)?1N.N DIR("B")=$P(R4("D"),U,4) D ^DIR G:X="" NEX^RMPRHISL I $D(DUOUT)&($P(R1(0),U,7)) K DIR G LIST^RMPRHISL G:$D(DIRUT) EXIT^RMPRHISL
|
|---|
| 57 | I $P(R1("AM"),U,3)=4 S $P(R1("AM"),U,4)=Y,$P(R4("D"),U,4)=$S(Y=1:"SPECIAL LEGISLATION",Y=2:"A&A",Y=3:"PHC",Y=4:"ELIGIBILITY REFORM",1:"") G ^RMPRHISL
|
|---|
