RMPR29R ;PHX/JLT,RVD-PRINT 2529-3 [ 10/01/94  5:39 AM ]
 ;;3.0;PROSTHETICS;**9,23,34,75**;Feb 09, 1996;Build 25
 ;get basic info, system variables
 D DIV4^RMPRSIT G:$D(X) EXIT
 K DIC S DIC=664.1,DIC(0)="AEQMZ"
 S DIC("A")="Select Patient Name or Date: "
 S DIC("S")="I $P(^(0),U,3)=RMPR(""STA"")&($P(^(0),U,17)'=""D""&($P(^(0),U,17)'=""C""))"
 S DIC("W")="D EN3^RMPRD1"
 D ^DIC G:+Y'>0 EXIT  S RMPRDA=+Y K DIC D PRT,EXIT Q
EN1(RMPRPTR) ;
PRT ;PRINT 2529-3 PASS RMPRDA
 ;CALLED BY RMPR29,RMPR29T
 ;REQUIRED VARIABLES: RMPRDA - ENTRY NUMBER IN FILE 664.1
 ;                    RMPRSITE - SITE OFSTATION PROCESSING 2529-3
 S DIC=4,DIC(0)="QXZN",X=$P(^RMPR(664.1,RMPRDA,0),U,15)
 D ^DIC G:+Y'>0 EXIT
 K IOP,X N RC
 S RMPRINS=+Y,RC=0
 S RMPRST=$S($D(^DIC(5,+$P(Y(0),U,2),0)):$P(^(0),U),1:"")
 I $D(^DIC(4,RMPRINS,1)) S RMPRAD(1)=$P(^(1),U,1),RMPRAD(2)=$P(^(1),U,2),RMPRCT=$P(^(1),U,3),RMPR9P=$P(^(1),U,4)
 S DIOBEG="S DFN=$P(^RMPR(664.1,RMPRDA,0),U,2),VAPA(""P"")=1,VAHOW=2 D ALL^VADPT"
 D:'$D(IOP) GETP
 ;
 I $P(^RMPR(664.1,RMPRDA,0),U,11)="N" N RMPRFCTR D
 .;national footwear center address in RMPRFCTR array used in print
 .;template RMPR 25293
 .S RMPRFCTR(1)="179TH ST & LINDEN BLVD."
 .S RMPRFCTR(2)="ST. ALBANS, NY 11425"
 ;
 S L=0,DIC="^RMPR(664.1,",FLDS="[RMPR 25293]",BY="@NUMBER",(FR,TO)=RMPRDA D EN1^DIP D KVAR^VADPT Q
EXIT ;common exit point
 K RMPRINS,RMPRST,RMPRAD,DIC,BY,DFN,DIOBEG,DIOEND,FLDS,FR,IOP,L,PNODE
 K RA,RB,RFL,RMPRCT,RMPRI,RMPRSC,RMPRWO,RMPR9P,SRC,TO,X,Y
 Q
INQ ;INQUIRE 2529-3 STATUS
 D DIV4^RMPRSIT G:$D(X) EXIT
 K DIC,DIR
 S DIC=664.1,DIC(0)="AEQMZ"
 S DIC("S")="I $P(^(0),U,3)=RMPR(""STA"")"
 S DIC("W")="D EN3^RMPRD1" D ^DIC G:+Y'>0 EXIT  S RMPRDA=+Y
 S L=0,DIC="^RMPR(664.1,",FLDS="[RMPR 2529-3 STATUS]"
 S BY="@NUMBER",(FR,TO)=RMPRDA
 S DIOEND="I IOST[""C"" X ""I $Y<21 F  W ! Q:$Y>21"" S DIR(0)=""E"" D ^DIR K DIR"
 D EN1^DIP G EXIT
STAT ;DISPLAY STATUS 2529-3
 D:'$D(RMPR) DIV4^RMPRSIT Q:$D(X)
 S STA=$G(DUZ(2))
 I $D(^XUSEC("RMPR LAB MENU",DUZ)) S RP=0 D  I RP>0  W !!,?5,$C(7),"There are '"_RP_"' 2529-3's Pending Assignment"
 .F RI=0:0 S RI=$O(^RMPR(664.1,"E","P",RI)) Q:RI'>0  I $D(^RMPR(664.1,RI,0)),$P(^(0),U,3)=STA S RP=RP+1
 I $D(^XUSEC("RMPR LAB MENU",DUZ)) S RP=0 D  I RP>0  W !!,?5,$C(7),"There are '"_RP_"' 2529-3's that have been Returned"
 .F RI=0:0 S RI=$O(^RMPR(664.1,"E","R",RI)) Q:RI'>0  I $D(^RMPR(664.1,RI,0)),$P(^(0),U,3)=STA S RP=RP+1
 I $D(^XUSEC("RMPR LAB SUPERVISOR",DUZ)) S RP=0 D  I RP>0  W !!,?5,$C(7),"There are '"_RP_"' Local 2529-3's Pending Completion"
 .F RI=0:0 S RI=$O(^RMPR(664.1,"E","PC",RI)) Q:RI'>0  I $D(^RMPR(664.1,RI,0)),$P(^(0),U,3)=STA,$P(^(0),U,15)=STA S RP=RP+1
 S (RP,RI)=0
 I $D(^XUSEC("RMPR LAB MENU",DUZ)) S RP=0 D  I RP>0  W !!,?5,$C(7),"There are '"_RP_"' Remote 2529-3's Pending Completion"
 .;count remote pending
 .F RI=0:0 S RI=$O(^RMPR(664.1,"E","PC",RI)) Q:RI'>0  I $D(^RMPR(664.1,RI,0)),$P(^(0),U,15)'=STA S RP=RP+1
 I $D(^XUSEC("RMPR LAB MENU",DUZ)) S RP=0 D  I RP>0  W !!,?5,$C(7),"There are '"_RP_"' Lab Stock Issue Pending Completion"
 .F RI=0:0 S RI=$O(^RMPR(664.1,"E","S",RI)) Q:RI'>0  I $D(^RMPR(664.1,RI,0)),$P(^(0),U,3)=STA,$P(^(0),U,15)=STA S RP=RP+1
 K RI,RP,STA Q
ZDSP ;DISPLAY WORK ORDER LIST
 F RMPRI=0:0 S RMPRI=$O(^RMPR(664.2,RMPRWO,1,RMPRI)) Q:RMPRI'>0  S RA=$P(^(RMPRI,0),U,1) I '$P(^(0),U,11) W !,?5,$$ITM1^RMPR31U(RA),?10,$$ITM^RMPR31U(RA)
 I $D(RFL) D
 .W ! S X="?",DIC="^RMPR(661,",DIC(0)="EQM"
 .S DIC("S")="S RA=$P(^(0),U,1) I $D(^PRCP(445,""AE"",RA,PRCP(""I"")))&($P(^RMPR(664.1,RMPRDA,0),U,17)'=""D""&($P(^(0),U,17)'=""C""))"
 .S DIC("W")="W ?10,$P(^PRC(441,$P(^(0),U,1),0),U,2)" D ^DIC K RFL
 Q
DSP ;DISPLAY 2529-3
 ;CALLED BY RMPR29
 ;REQUIRED VARIABLE: RMPRDA - ENTRY INF FILE 664.1
 N DFN S DFN=$P(^RMPR(664.1,RMPRDA,0),U,2) D DEM^VADPT
 S L=0,DIC="^RMPR(664.1,",FLDS="[RMPR 2529 EDT]",BY="@NUMBER",(FR,TO)=RMPRDA,IOP="HOME" D EN1^DIP
 Q
LOC ;Display Request Location
 ;CALLED BY RMPR29
 ;REQUIRED VARIABLE: RMPRDA - ENTRY NUMBER IN FILE 664.1
 S RB=^RMPR(664.1,RMPRDA,0),RMPRSC=$P(RB,U,11) K RB
 S RA="O:ORTHOTIC LAB;R:RESTORATION LAB;S:SHOE LAST CLINIC;W:WHEELCHAIR REPAIR SHOP;N:NATIONAL FOOT CENTER;D:DDC;"
 W !!,?5,"2529-3 Request Sent to ",$E($P($P(RA,RMPRSC_":",2),";",1),1,25)
 Q
GETP ;GET CORRECT PRINTER FOR 2529-3
 ;ADDED PIECE 1 TO 669.9,DEV NODE FOR PRINTER FOR EYE CLINIC FOR 75
 N SRC,PNODE S SRC=$P($G(^RMPR(664.1,RMPRDA,0)),U,11),PNODE=$P($G(^RMPR(669.9,RMPRSITE,"DEV")),U,1,99)
 I $D(RMPRPTR),+RMPRPTR>0 S X=RMPRPTR
 E  S X=$S(SRC="N"!(SRC="D"):$P($G(^RMPR(669.9,RMPRSITE,0)),U,5),SRC="E":$P(PNODE,U),SRC="O":$P(PNODE,U,2),SRC="R":$P(PNODE,U,3),SRC="S":$P(PNODE,U,4),SRC="W":$P(PNODE,U,5),1:"")
 ;see internal notes
 S DIC="^%ZIS(1,",DIC(0)="NZ" D ^DIC I +Y>0 S IOP="Q;"_Y(0,0),DQTIME="NOW" W !!,$C(7),?5,"2529-3 Printout has been sent to Device "_Y(0,0),!!
 Q