Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPR29R

RMPR29R.m

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