- 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 Mar 13, 2025@21:39:45 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
