- RMPOLF2 ;HIN CIOFO/RVD-CONTINUATION OF RMPOLF1 ;06/22/99
- ;;3.0;PROSTHETICS;**29**;Feb 09, 1996
- VIEW ;VIEW LETTERS FROM ELIG SCREEN2 UNDER ISSUE FROM STOCK
- N RMPRDA,DA,RMPRIN
- Q:$G(DFN)=""!(%=3)
- S RMPRFF=1 I '$D(^RMPR(665.4,"B",DFN)) G RO1
- K KILL
- W !!,"Letters on file:"
- ;!,?5,"Type",?29,"Employee",?55,"Date or Vendor"
- ASK1 ;SET UP REVERSE LETTER LIST & ASK IF USER WANTS TO VIEW MORE LETTERS
- D EN^RMPRUTL2
- S DA=RMPRIN G:$G(DA)'>0 ASK2
- S RMPRIN=DA D PRINT^RMPOLF1
- MOLET K DA,RMPRDA,RMPRIN
- S %=2 W !,"Would you like to see more letters" D YN^DICN
- I %=-1 S KILL=1 Q
- I %=0 W !,"'YES' will let you review another letter for this patient",!,"'NO' will let you continue the program"
- I W !,"Enter '^' to exit the correspondence screen totally" G MOLET
- I %=2 S KILL=1 D RO1 Q
- I %=1 G ASK1
- G RO1
- ASK2 ;Q:RMPRIN=-1
- S %=2 W !,"Do you wish to view a letter" D YN^DICN Q:$D(DTOUT) S:%<0 KILL=1 G:%=2!(%<0) RO1
- I %=0 W !,"Answer `YES` or `NO`" G ASK2
- I %=1 G VIEW
- ;I %=1 S %=3 G VIEW
- ASK3 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
- I %=1 I $G(X)'="" I $G(RMPR9VA($G(X)))=""&($G(RMPRDFN)'="") S RMPR9VA($G(X))=RMPRDFN
- I %=1,$D(^RMPR(665.4,RMPR9VA(+X),0)) S RMPRIN=RMPR9VA(+X),RMPREN=1 D PRINT^RMPOLF1 G VIEW
- RO1 ;K RMPREN S %=2 W !,"Do you wish to create a correspondence letter" D YN^DICN
- ;I %=1 D CUM^RMPOLF0 Q
- ;I %=0 W !,"Answer `YES` to create a form letter, `NO` to continue." G RO1
- ;I %=2 K RMPRBB,RMPRFF,RMPR9ZRO,RMPR9VA(1),RMPR9VA(2)
- ;S %=3 Q
- Q
- ;
- EN4 ;EDIT A SKELETON
- K DIC S DIC="^RMPR(665.2,",DIC(0)="AEQLM",DLAYGO=665.2 D ^DIC K DLAYGO
- I +Y<0!($P(Y,U,4)["1") W !!,"SORRY, THIS IS A NON-EDITABLE LETTER" Q
- 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
- 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
- DEN 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
- Q:%<0
- I %=0 G QUES1
- S $P(^RMPR(665.2,RMPRIN,0),U,2)=$S(%=2:0,%=1:1,1:"")
- Q
- QUES1 W !,"Enter `YES` if letter is an AMIS Denial" G DEN
- EN3 ;PRINT FORM LETTER
- I '$D(RMPR("SIG")) D DIV4^RMPRSIT Q:$D(X)
- D HOME^%ZIS
- ;CHECK IF IT IS THE ADP FL 10-90
- K DIC S DIC="^RMPR(665.2,",DIC(0)="AEQM" D ^DIC Q:+Y<0
- S RMPRIN=+Y K DIC
- ;check if it is the ADP FL 10-90
- PR S DIWF="^RMPR(665.2,RMPRIN,1,",DIWF(1)=665.2,BY="@NUMBER",FR=RMPRIN,TO=RMPRIN D EN2^DIWF
- Q
- ;
- SET 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
- G PRINT^RMPOLF1
- Q
- ;
- 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",$J,1,RMPRIN)=DFN
- Q
- WRITE S:$G(RMPR9ZRO)'=""&(RO="") RO=RMPR9ZRO
- 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
- .D ^DIR
- .I $G(X)="" Q
- .I $G(X)>0&($G(RO)>0&($G(X)<(RO+1))) S DA=^TMP($J,"RMPR",RO) W !,"***",DA Q
- 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")
- S:$D(^RMPR(665.4,^TMP($J,"RMPR",RO),2)) RMPR2=$P(^RMPR(665.4,^TMP($J,"RMPR",RO),2),U,1)
- ;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:"")
- 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
- 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)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPOLF2 4338 printed Feb 18, 2025@23:57:31 Page 2
- RMPOLF2 ;HIN CIOFO/RVD-CONTINUATION OF RMPOLF1 ;06/22/99
- +1 ;;3.0;PROSTHETICS;**29**;Feb 09, 1996
- VIEW ;VIEW LETTERS FROM ELIG SCREEN2 UNDER ISSUE FROM STOCK
- +1 NEW RMPRDA,DA,RMPRIN
- +2 if $GET(DFN)=""!(%=3)
- QUIT
- +3 SET RMPRFF=1
- IF '$DATA(^RMPR(665.4,"B",DFN))
- GOTO RO1
- +4 KILL KILL
- +5 WRITE !!,"Letters on file:"
- +6 ;!,?5,"Type",?29,"Employee",?55,"Date or Vendor"
- ASK1 ;SET UP REVERSE LETTER LIST & ASK IF USER WANTS TO VIEW MORE LETTERS
- +1 DO EN^RMPRUTL2
- +2 SET DA=RMPRIN
- if $GET(DA)'>0
- GOTO ASK2
- +3 SET RMPRIN=DA
- DO PRINT^RMPOLF1
- MOLET KILL DA,RMPRDA,RMPRIN
- +1 SET %=2
- WRITE !,"Would you like to see more letters"
- DO YN^DICN
- +2 IF %=-1
- SET KILL=1
- QUIT
- +3 IF %=0
- WRITE !,"'YES' will let you review another letter for this patient",!,"'NO' will let you continue the program"
- +4 IF $TEST
- WRITE !,"Enter '^' to exit the correspondence screen totally"
- GOTO MOLET
- +5 IF %=2
- SET KILL=1
- DO RO1
- QUIT
- +6 IF %=1
- GOTO ASK1
- +7 GOTO RO1
- ASK2 ;Q:RMPRIN=-1
- +1 SET %=2
- WRITE !,"Do you wish to view a letter"
- DO YN^DICN
- if $DATA(DTOUT)
- QUIT
- if %<0
- SET KILL=1
- if %=2!(%<0)
- GOTO RO1
- +2 IF %=0
- WRITE !,"Answer `YES` or `NO`"
- GOTO ASK2
- +3 IF %=1
- GOTO VIEW
- +4 ;I %=1 S %=3 G VIEW
- ASK3 IF %=2
- KILL X
- READ !!,"Enter the number: ",X:DTIME
- if '$TEST!(X="")
- QUIT
- if X="^"
- QUIT
- IF X>(I-1)!(+X<1)!(X'?1N.N)
- WRITE !,$CHAR(7),"Enter a number between 1 and ",(I-1)_" or `^` to quit."
- GOTO ASK3
- +1 IF %=1
- IF $GET(X)'=""
- IF $GET(RMPR9VA($GET(X)))=""&($GET(RMPRDFN)'="")
- SET RMPR9VA($GET(X))=RMPRDFN
- +2 IF %=1
- IF $DATA(^RMPR(665.4,RMPR9VA(+X),0))
- SET RMPRIN=RMPR9VA(+X)
- SET RMPREN=1
- DO PRINT^RMPOLF1
- GOTO VIEW
- RO1 ;K RMPREN S %=2 W !,"Do you wish to create a correspondence letter" D YN^DICN
- +1 ;I %=1 D CUM^RMPOLF0 Q
- +2 ;I %=0 W !,"Answer `YES` to create a form letter, `NO` to continue." G RO1
- +3 ;I %=2 K RMPRBB,RMPRFF,RMPR9ZRO,RMPR9VA(1),RMPR9VA(2)
- +4 ;S %=3 Q
- +5 QUIT
- +6 ;
- EN4 ;EDIT A SKELETON
- +1 KILL DIC
- SET DIC="^RMPR(665.2,"
- SET DIC(0)="AEQLM"
- SET DLAYGO=665.2
- DO ^DIC
- KILL DLAYGO
- +2 IF +Y<0!($PIECE(Y,U,4)["1")
- WRITE !!,"SORRY, THIS IS A NON-EDITABLE LETTER"
- QUIT
- +3 SET RMPRIN=+Y
- LOCK +^RMPR(665.2,RMPRIN,0):1
- IF $TEST=0
- WRITE !,$CHAR(7),?5,"Someone else is Editing this entry!"
- KILL RMPRIN
- QUIT
- +4 SET DIE="^RMPR(665.2,"
- SET DA=RMPRIN
- SET DR=".01;1"
- SET DIE("NO^")=""
- DO ^DIE
- LOCK -^RMPR(665.2,RMPRIN,0)
- IF '$DATA(DA)!($DATA(DTOUT))!($DATA(DUOUT))
- QUIT
- DEN SET %=$SELECT($PIECE(^RMPR(665.2,RMPRIN,0),U,2)=1:1,1:2)
- WRITE !,"Is this a Denial type of letter"
- DO YN^DICN
- +1 if %<0
- QUIT
- +2 IF %=0
- GOTO QUES1
- +3 SET $PIECE(^RMPR(665.2,RMPRIN,0),U,2)=$SELECT(%=2:0,%=1:1,1:"")
- +4 QUIT
- QUES1 WRITE !,"Enter `YES` if letter is an AMIS Denial"
- GOTO DEN
- EN3 ;PRINT FORM LETTER
- +1 IF '$DATA(RMPR("SIG"))
- DO DIV4^RMPRSIT
- if $DATA(X)
- QUIT
- +2 DO HOME^%ZIS
- +3 ;CHECK IF IT IS THE ADP FL 10-90
- +4 KILL DIC
- SET DIC="^RMPR(665.2,"
- SET DIC(0)="AEQM"
- DO ^DIC
- if +Y<0
- QUIT
- +5 SET RMPRIN=+Y
- KILL DIC
- +6 ;check if it is the ADP FL 10-90
- PR SET DIWF="^RMPR(665.2,RMPRIN,1,"
- SET DIWF(1)=665.2
- SET BY="@NUMBER"
- SET FR=RMPRIN
- SET TO=RMPRIN
- DO EN2^DIWF
- +1 QUIT
- +2 ;
- SET 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 GOTO PRINT^RMPOLF1
- +5 QUIT
- +6 ;
- 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",$JOB,1,RMPRIN)=DFN
- +5 QUIT
- WRITE if $GET(RMPR9ZRO)'=""&(RO="")
- SET RO=RMPR9ZRO
- +1 IF I#15=0
- SET DIR(0)="FAOU^1:245"
- SET DIR("A")="End of page: select a letter by number or enter'^' to continue listining"
- Begin DoDot:1
- +2 DO ^DIR
- +3 IF $GET(X)=""
- QUIT
- +4 IF $GET(X)>0&($GET(RO)>0&($GET(X)<(RO+1)))
- SET DA=^TMP($JOB,"RMPR",RO)
- WRITE !,"***",DA
- QUIT
- End DoDot:1
- IF $GET(X)="^"
- QUIT
- +5 WRITE !,I_" ",?4,$SELECT($DATA(^RMPR(665.2,+$PIECE(^RMPR(665.4,^TMP($JOB,"RMPR",RO),0),U,2),0)):$EXTRACT($PIECE(^(0),U,1),1,20),1:"UNKNOWN")
- +6 if $DATA(^RMPR(665.4,^TMP($JOB,"RMPR",RO),2))
- SET RMPR2=$PIECE(^RMPR(665.4,^TMP($JOB,"RMPR",RO),2),U,1)
- +7 ;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:"")
- +8 SET RMPRPP=$GET(^VA(200,+$PIECE(^RMPR(665.4,^TMP($JOB,"RMPR",RO),0),U,4),0))'=""
- WRITE ?27,$EXTRACT($PIECE(^(0),U),1,15)
- KILL RMPRPP
- +9 SET Y=$SELECT($PIECE(^RMPR(665.4,^TMP($JOB,"RMPR",RO),0),U,3):$PIECE(^RMPR(665.4,^TMP($JOB,"RMPR",RO),0),U,3),$DATA(RMPR2):$PIECE(^PRC(440,RMPR2,0),U,1),1:"")
- DO DD^%DT
- WRITE ?55,$EXTRACT(Y,1,24)
- SET RMPR9VA(I)=^TMP($JOB,"RMPR",RO)
- +10 QUIT
