RMPRHISD ;PHX/RFM-DELETE HISTORICAL DATA ENTRY ;8/29/1994
;;3.0;PROSTHETICS;**19,90**;Feb 09, 1996
EN D DIV4^RMPRSIT G:$D(X) EXIT D HOME^%ZIS
S DIC("S")="I $P(^(0),U,13)=13,$P(^(0),U,10)=RMPR(""STA"")"
S DIC="^RMPR(660,",DIC(0)="AEMQ",DIC("A")="Select PATIENT: ",DIC("W")="D ^RMPRD1" D ^DIC G:Y<0 EXIT
S %X=DIC_+Y_",",%Y="R1(" D %XY^%RCR K DIC
S RMPRIEN=+Y,RMPRNAM=$P(^DPT($P(R1(0),U,2),0),U,1),RMPRSSN=$P(^DPT($P(R1(0),U,2),0),U,9)
S R3("D")="",R4("D")="",RMPRHISD=1
S $P(R3("D"),U,14)=$S($P(R1(0),U,14)="C":"COMMERCIAL",$P(R1(0),U,14)="V":"VA",1:"")
S $P(R3("D"),U,4)=$S($P(R1(0),U,4)="I":"INITIAL ISSUE",$P(R1(0),U,4)="X":"REPAIR",$P(R1(0),U,4)="R":"REPLACE",$P(R1(0),U,4)="S":"SPARE",$P(R1(0),U,4)="5":"RENTAL",1:"")
S $P(R4("D"),U,3)=$S($P(R1("AM"),U,3)=1:"SC/OP",$P(R1("AM"),U,3)=2:"SC/IP",$P(R1("AM"),U,3)=3:"NSC/IP",$P(R1("AM"),U,3)=4:"NSC/OP")
S:$P(R1("AM"),U,3)=4&($P(R1("AM"),U,4)) $P(R4("D"),U,4)=$S($P(R1("AM"),U,4)=1:"SPECIAL LEGISLATION",$P(R1("AM"),U,4)=2:"A&A",$P(R1("AM"),U,4)=3:"PHC",$P(R1("AM"),U,4)=4:"ELIGIBILITY REFORM",1:"")
S $P(R3("D"),U,6)=$P(^RMPR(661,$P(R1(0),U,6),0),U,1),RMPROIT=$P(R3("D"),U,6),Y=$P(R1(0),U,12) G:Y="" CO D DD^%DT S $P(R3("D"),U,12)=Y,RMPROQT=$P(R1(0),U,7)
CO D ^RMPRST2
DEL S DIR(0)="Y",DIR("B")="NO",DIR("A")="Would you like to Delete this Transaction" D ^DIR G:$D(DIRUT) EXIT I +Y=1 S DIK="^RMPR(660,",DA=RMPRIEN D ^DIK W !?10,"Deleted..." H 1 G EXIT
K DIR,Y S DIR(0)="Y",DIR("B")="YES",DIR("A")="Would you like to Edit this Transaction" D ^DIR G:$D(DIRUT) EXIT I +Y=1 S DIE="^RMPR(660,",DA=RMPRIEN,DR="1R;12R;4R;7R;2R;62R;63;14R~UNIT COST;5R;10;9;21" D ^DIE G CO
EXIT K DIK,J,DIC,DIR,DA,%,HL,RMPRNAM,RMPRSSN,RMPRHISD,RMPRIEN,RMPROIT,RMPROQT,RMPRIPT,R1,R3,R4,Y,X,RZZZ,%X,%Y Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRHISD 1756 printed Oct 16, 2024@18:35:30 Page 2
RMPRHISD ;PHX/RFM-DELETE HISTORICAL DATA ENTRY ;8/29/1994
+1 ;;3.0;PROSTHETICS;**19,90**;Feb 09, 1996
EN DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
DO HOME^%ZIS
+1 SET DIC("S")="I $P(^(0),U,13)=13,$P(^(0),U,10)=RMPR(""STA"")"
+2 SET DIC="^RMPR(660,"
SET DIC(0)="AEMQ"
SET DIC("A")="Select PATIENT: "
SET DIC("W")="D ^RMPRD1"
DO ^DIC
if Y<0
GOTO EXIT
+3 SET %X=DIC_+Y_","
SET %Y="R1("
DO %XY^%RCR
KILL DIC
+4 SET RMPRIEN=+Y
SET RMPRNAM=$PIECE(^DPT($PIECE(R1(0),U,2),0),U,1)
SET RMPRSSN=$PIECE(^DPT($PIECE(R1(0),U,2),0),U,9)
+5 SET R3("D")=""
SET R4("D")=""
SET RMPRHISD=1
+6 SET $PIECE(R3("D"),U,14)=$SELECT($PIECE(R1(0),U,14)="C":"COMMERCIAL",$PIECE(R1(0),U,14)="V":"VA",1:"")
+7 SET $PIECE(R3("D"),U,4)=$SELECT($PIECE(R1(0),U,4)="I":"INITIAL ISSUE",$PIECE(R1(0),U,4)="X":"REPAIR",$PIECE(R1(0),U,4)="R":"REPLACE",$PIECE(R1(0),U,4)="S":"SPARE",$PIECE(R1(0),U,4)="5":"RENTAL",1:"")
+8 SET $PIECE(R4("D"),U,3)=$SELECT($PIECE(R1("AM"),U,3)=1:"SC/OP",$PIECE(R1("AM"),U,3)=2:"SC/IP",$PIECE(R1("AM"),U,3)=3:"NSC/IP",$PIECE(R1("AM"),U,3)=4:"NSC/OP")
+9 if $PIECE(R1("AM"),U,3)=4&($PIECE(R1("AM"),U,4))
SET $PIECE(R4("D"),U,4)=$SELECT($PIECE(R1("AM"),U,4)=1:"SPECIAL LEGISLATION",$PIECE(R1("AM"),U,4)=2:"A&A",$PIECE(R1("AM"),U,4)=3:"PHC",$PIECE(R1("AM"),U,4)=4:"ELIGIBILITY REFORM",1:"")
+10 SET $PIECE(R3("D"),U,6)=$PIECE(^RMPR(661,$PIECE(R1(0),U,6),0),U,1)
SET RMPROIT=$PIECE(R3("D"),U,6)
SET Y=$PIECE(R1(0),U,12)
if Y=""
GOTO CO
DO DD^%DT
SET $PIECE(R3("D"),U,12)=Y
SET RMPROQT=$PIECE(R1(0),U,7)
CO DO ^RMPRST2
DEL SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Would you like to Delete this Transaction"
DO ^DIR
if $DATA(DIRUT)
GOTO EXIT
IF +Y=1
SET DIK="^RMPR(660,"
SET DA=RMPRIEN
DO ^DIK
WRITE !?10,"Deleted..."
HANG 1
GOTO EXIT
+1 KILL DIR,Y
SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Would you like to Edit this Transaction"
DO ^DIR
if $DATA(DIRUT)
GOTO EXIT
IF +Y=1
SET DIE="^RMPR(660,"
SET DA=RMPRIEN
SET DR="1R;12R;4R;7R;2R;62R;63;14R~UNIT COST;5R;10;9;21"
DO ^DIE
GOTO CO
EXIT KILL DIK,J,DIC,DIR,DA,%,HL,RMPRNAM,RMPRSSN,RMPRHISD,RMPRIEN,RMPROIT,RMPROQT,RMPRIPT,R1,R3,R4,Y,X,RZZZ,%X,%Y
QUIT
