RMPR29M ;PHX/JLT-E/MAIL FOR 2529-3 ACTION [4/14/95]
;;3.0;PROSTHETICS;;Feb 09, 1996
CA21(RDA,PDA) ;CANCEL 2421 MESSAGE FOR ^RMPR(664.1,RDA) AND ^RMPR(664,PDA)
;CALLED FROM RMPR29C Cancel a 2529-3
;VARIABLES REQUIRED: RDA- ENTRY NUMBER IN FILE 664.1
; PDA - ENTRY NUMBER IN FILE 664
; RMPRWO - WORK ORDER
; SET: XMTEXT - TEXT FOR MAIL MESSAGE.
Q:'$D(^RMPR(664.1,RDA,0))
N RMPRWO,RMPRREF
S RMPRWO=$P(^RMPR(664.1,RDA,0),U,13)
;rmprref is the reference number ot ifcap
S RMPRREF=$P($G(^RMPR(664,PDA,0)),U,7)
;quit if the purchase has been cancelled or closed-out already
I $D(^RMPR(664,PDA,0)),($P(^(0),8,0)!($P(^(0),U,5))) Q
;send message
K XMY
I RMPRREF'="" S XMSUB="Request to Cancel Prosthetics Purchase "_RMPRREF,RTX(1)="Work Order # "_RMPRWO_" has been Canceled.",RTX(2)="Please take action on "_RMPRREF_"."
E S XMSUB="2421 Request for Work Order # "_RMPRWO_" has been Canceled",RTX(1)="2421 Request for Work Order # "_RMPRWO_" has been Canceled"
S RTX(3)="BY: "_$$EMP^RMPR31U(DUZ)
;get cancellation remarks from the 2529-3
F RT=0:0 S RT=$O(^RMPR(664.1,RDA,4,RT)) Q:RT'>0 I $D(^(RT,0)) S RTX(RT+3)=^(0)
;
D ADM,SUP
I $D(XMY) S XMTEXT="RTX(" D ^XMD K XMY,RTX
Q
;
IRQ ;SEND 2421 REQUEST NOTIFICATION
Q:'$D(^RMPR(664.1,RMPRDA,0)) N RMPRWO S RMPRWO=$P(^RMPR(664.1,RMPRDA,0),U,13) K XMY
S XMSUB="2421 Request for Work Order # "_RMPRWO_" has been initiated",RTX(1)="2421 Request for Work Order # "_RMPRWO_" has been intiated"
S RTX(2)="BY: "_$$EMP^RMPR31U(DUZ)
D ADM,SUP I $D(XMY) S XMTEXT="RTX(" D ^XMD K XMY,RTX
Q
ADM ;MAKE HOLDERS OF 'RMPR LAB ADMIN' KEY RECEIVER OF MESSAGE.
F RT=0:0 S RT=$O(^XUSEC("RMPR LAB ADMIN",RT)) Q:RT'>0 S XMY(RT)=""
Q
SUP ;MAKE HOLDERS OF 'RMPR LAB SUPERVISOR' KEY RECEIVERS OF MESSAGE ALSO.
F RT=0:0 S RT=$O(^XUSEC("RMPR LAB SUPERVISOR",RT)) Q:RT'>0 S XMY(RT)=""
Q
RTM ;RETURN 2529-3 TO LAB
;CALLED BY RMPR29C
;VARIABLES REQUIRED - RMPRDA ENTRY NUMBER IN FIRL 664.1
N PEMP,RMPRWO S PEMP=$P(^RMPR(664.1,RMPRDA,0),U,16),RMPRWO=$P(^(0),U,13) I +PEMP>0 S XMY(PEMP)=""
F RI=0:0 S RI=$O(^RMPR(664.1,RMPRDA,2,RI)) Q:RI'>0 I $D(^(RI,0)) S RDA=^(0),RA=$P(RDA,U,5) D
.F DA=0:0 S DA=$O(^RMPR(664.3,"C",RA,DA)) Q:DA'>0 I $D(^RMPR(664.3,DA)) F RU=0:0 S RU=$O(^RMPR(664.3,DA,1,RU)) Q:RU'>0 I $D(^(RU,0)) S PEMP=$P(^(0),U) I PEMP>0 S XMY(PEMP)=""
S XMSUB="Work Order # "_RMPRWO_" Returned to Lab",RTX(1)=XMSUB,RTX(2)="BY: "_$$EMP^RMPR31U(DUZ)
F RR=0:0 S RR=$O(^RMPR(664.1,RMPRDA,6,RR)) Q:RR'>0 I $D(^(RR,0)) S RTX(RR+2)=^(0)
D SUP I $D(XMY) S XMTEXT="RTX(" D ^XMD K XMY,RTX
Q
CA0(RDA,PDA) ;CANCEL 2421 OBLIGATION
Q:'$D(^RMPR(664.1,RDA,0)) N RMPRWO,RMPRREF S RMPRWO=$P(^RMPR(664.1,RDA,0),U,13),RMPRREF=$P($G(^RMPR(664,PDA,0)),U,7) K XMY
S XMSUB="2421 Request "_RMPRREF_" for Work Order # "_RMPRWO_" has been Canceled",RTX(1)="2421 Request "_RMPRREF_" for Work Order # "_RMPRWO_" has been Canceled"
S RTX(2)="BY: "_$$EMP^RMPR31U(DUZ)
S PEMP=$P(^RMPR(664.1,RDA,0),U,16) I +PEMP>0 S XMY(PEMP)=""
F RI=0:0 S RI=$O(^RMPR(664.1,RDA,2,RI)) Q:RI'>0 I $D(^(RI,0)) S RDA=^(0),RA=$P(RDA,U,5) D
.F DA=0:0 S DA=$O(^RMPR(664.3,"C",RA,DA)) Q:DA'>0 I $D(^RMPR(664.3,DA)) F RU=0:0 S RU=$O(^RMPR(664.3,DA,1,RU)) Q:RU'>0 I $D(^(RU,0)) S PEMP=$P(^(0),U) I PEMP>0 S XMY(PEMP)=""
D SUP I $D(XMY) S XMTEXT="RTX(" D ^XMD K XMY,RTX
Q
DA0(RDA,PDA) ;DELIVER 2421
Q:'$D(^RMPR(664.1,RDA,0)) N RMPRWO,RMPRREF S RMPRWO=$P(^RMPR(664.1,RDA,0),U,13),RMPRREF=$P($G(^RMPR(664,PDA,0)),U,7) K XMY
S XMSUB="2421 Request "_RMPRREF_" for Work Order # "_RMPRWO_" has been Delivered"
S RTX(1)="The 2421 Request "_RMPRREF_"has been closed out,"
S RTX(2)="by "_$$EMP^RMPR31U(DUZ)_"."
S RTX(3)=" "
S RTX(4)="This is associated with Work Order # "_RMPRWO_","
S RTX(5)="assigned to technician "_$P(^VA(200,$P(^RMPR(664.1,RDA,0),U,16),0),U,1)_"."
S PEMP=$P(^RMPR(664.1,RDA,0),U,16) I +PEMP>0 S XMY(PEMP)=""
F RI=0:0 S RI=$O(^RMPR(664.1,RDA,2,RI)) Q:RI'>0 I $D(^(RI,0)) S RDA=^(0),RA=$P(RDA,U,5) D
.F DA=0:0 S DA=$O(^RMPR(664.3,"C",RA,DA)) Q:DA'>0 I $D(^RMPR(664.3,DA)) F RU=0:0 S RU=$O(^RMPR(664.3,DA,1,RU)) Q:RU'>0 I $D(^(RU,0)) S PEMP=$P(^(0),U) I PEMP>0 S XMY(PEMP)=""
D SUP I $D(XMY) S XMTEXT="RTX(" D ^XMD K XMY,RTX
Q
DEL(PDA) ;DELETED 2421 REQUEST
Q:('$D(^RMPR(664,PDA,0))) K XMY N RMPRWO S RMPRWO=$P($G(^RMPR(664.2,+$P(^(0),U,15),0)),U) I $P(^RMPR(664,PDA,0),U,16) S XMY($P(^(0),U,16))=""
S DIE="^RMPR(664,",DA=RMPRA,DR="24" D ^DIE S XMSUB="2421 Request for Work Order # "_RMPRWO_" Has been Deleted",RTX(1)=XMSUB,RTX(2)="BY: "_$$EMP^RMPR31U(DUZ)
F RW=0:0 S RW=$O(^RMPR(664,PDA,4,RW)) Q:RW'>0 I $D(^(RW,0)) S RTX(RW+3)=^(0)
D SUP I $D(XMY) S XMTEXT="RTX(" D ^XMD K XMY,RTX
Q
SLK ;SETUP DIC("S") FOR LABOR HOURS
;see internal notes
;CALLED FROM RMPR29B
;VARIABLES REQUIRED: + Y
S DIC("S")="I $P(^RMPR(664.3,+Y,0),U,2)=DA660",DIC("W")="F ZI=0:0 S ZI=$O(^RMPR(664.3,+Y,1,ZI)) Q:+ZI'>0 I $D(^(ZI,0)) W ?40,$$EMP^RMPR31U($P(^(0),U)) I $O(^RMPR(664.3,+Y,1,ZI)) W !",DLAYGO=664.3,DIC="^RMPR(664.3,",DIC(0)="QML" Q
Q
PAP ;PURCHASE APPROVAL
Q
;N RMPR90I
;D DIV4^RMPRSIT
;I '$D(^XUSEC("RMPRSUPERVISOR",DUZ)) Q
;S CNT=0 S RMPR90I=0 F S RMPR90I=$O(^RMPR(664,"AP",RMPR("STA"),RMPR90I)) Q:RMPR90I'>0 S CNT=CNT+1
;I +CNT W !!,?5,$C(7),"There "_$S(CNT>1:"are ",1:"is ")_CNT_" Purchase Request(s) Pending Approval"
;Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR29M 5409 printed Oct 16, 2024@18:33:01 Page 2
RMPR29M ;PHX/JLT-E/MAIL FOR 2529-3 ACTION [4/14/95]
+1 ;;3.0;PROSTHETICS;;Feb 09, 1996
CA21(RDA,PDA) ;CANCEL 2421 MESSAGE FOR ^RMPR(664.1,RDA) AND ^RMPR(664,PDA)
+1 ;CALLED FROM RMPR29C Cancel a 2529-3
+2 ;VARIABLES REQUIRED: RDA- ENTRY NUMBER IN FILE 664.1
+3 ; PDA - ENTRY NUMBER IN FILE 664
+4 ; RMPRWO - WORK ORDER
+5 ; SET: XMTEXT - TEXT FOR MAIL MESSAGE.
+6 if '$DATA(^RMPR(664.1,RDA,0))
QUIT
+7 NEW RMPRWO,RMPRREF
+8 SET RMPRWO=$PIECE(^RMPR(664.1,RDA,0),U,13)
+9 ;rmprref is the reference number ot ifcap
+10 SET RMPRREF=$PIECE($GET(^RMPR(664,PDA,0)),U,7)
+11 ;quit if the purchase has been cancelled or closed-out already
+12 IF $DATA(^RMPR(664,PDA,0))
IF ($PIECE(^(0),8,0)!($PIECE(^(0),U,5)))
QUIT
+13 ;send message
+14 KILL XMY
+15 IF RMPRREF'=""
SET XMSUB="Request to Cancel Prosthetics Purchase "_RMPRREF
SET RTX(1)="Work Order # "_RMPRWO_" has been Canceled."
SET RTX(2)="Please take action on "_RMPRREF_"."
+16 IF '$TEST
SET XMSUB="2421 Request for Work Order # "_RMPRWO_" has been Canceled"
SET RTX(1)="2421 Request for Work Order # "_RMPRWO_" has been Canceled"
+17 SET RTX(3)="BY: "_$$EMP^RMPR31U(DUZ)
+18 ;get cancellation remarks from the 2529-3
+19 FOR RT=0:0
SET RT=$ORDER(^RMPR(664.1,RDA,4,RT))
if RT'>0
QUIT
IF $DATA(^(RT,0))
SET RTX(RT+3)=^(0)
+20 ;
+21 DO ADM
DO SUP
+22 IF $DATA(XMY)
SET XMTEXT="RTX("
DO ^XMD
KILL XMY,RTX
+23 QUIT
+24 ;
IRQ ;SEND 2421 REQUEST NOTIFICATION
+1 if '$DATA(^RMPR(664.1,RMPRDA,0))
QUIT
NEW RMPRWO
SET RMPRWO=$PIECE(^RMPR(664.1,RMPRDA,0),U,13)
KILL XMY
+2 SET XMSUB="2421 Request for Work Order # "_RMPRWO_" has been initiated"
SET RTX(1)="2421 Request for Work Order # "_RMPRWO_" has been intiated"
+3 SET RTX(2)="BY: "_$$EMP^RMPR31U(DUZ)
+4 DO ADM
DO SUP
IF $DATA(XMY)
SET XMTEXT="RTX("
DO ^XMD
KILL XMY,RTX
+5 QUIT
ADM ;MAKE HOLDERS OF 'RMPR LAB ADMIN' KEY RECEIVER OF MESSAGE.
+1 FOR RT=0:0
SET RT=$ORDER(^XUSEC("RMPR LAB ADMIN",RT))
if RT'>0
QUIT
SET XMY(RT)=""
+2 QUIT
SUP ;MAKE HOLDERS OF 'RMPR LAB SUPERVISOR' KEY RECEIVERS OF MESSAGE ALSO.
+1 FOR RT=0:0
SET RT=$ORDER(^XUSEC("RMPR LAB SUPERVISOR",RT))
if RT'>0
QUIT
SET XMY(RT)=""
+2 QUIT
RTM ;RETURN 2529-3 TO LAB
+1 ;CALLED BY RMPR29C
+2 ;VARIABLES REQUIRED - RMPRDA ENTRY NUMBER IN FIRL 664.1
+3 NEW PEMP,RMPRWO
SET PEMP=$PIECE(^RMPR(664.1,RMPRDA,0),U,16)
SET RMPRWO=$PIECE(^(0),U,13)
IF +PEMP>0
SET XMY(PEMP)=""
+4 FOR RI=0:0
SET RI=$ORDER(^RMPR(664.1,RMPRDA,2,RI))
if RI'>0
QUIT
IF $DATA(^(RI,0))
SET RDA=^(0)
SET RA=$PIECE(RDA,U,5)
Begin DoDot:1
+5 FOR DA=0:0
SET DA=$ORDER(^RMPR(664.3,"C",RA,DA))
if DA'>0
QUIT
IF $DATA(^RMPR(664.3,DA))
FOR RU=0:0
SET RU=$ORDER(^RMPR(664.3,DA,1,RU))
if RU'>0
QUIT
IF $DATA(^(RU,0))
SET PEMP=$PIECE(^(0),U)
IF PEMP>0
SET XMY(PEMP)=""
End DoDot:1
+6 SET XMSUB="Work Order # "_RMPRWO_" Returned to Lab"
SET RTX(1)=XMSUB
SET RTX(2)="BY: "_$$EMP^RMPR31U(DUZ)
+7 FOR RR=0:0
SET RR=$ORDER(^RMPR(664.1,RMPRDA,6,RR))
if RR'>0
QUIT
IF $DATA(^(RR,0))
SET RTX(RR+2)=^(0)
+8 DO SUP
IF $DATA(XMY)
SET XMTEXT="RTX("
DO ^XMD
KILL XMY,RTX
+9 QUIT
CA0(RDA,PDA) ;CANCEL 2421 OBLIGATION
+1 if '$DATA(^RMPR(664.1,RDA,0))
QUIT
NEW RMPRWO,RMPRREF
SET RMPRWO=$PIECE(^RMPR(664.1,RDA,0),U,13)
SET RMPRREF=$PIECE($GET(^RMPR(664,PDA,0)),U,7)
KILL XMY
+2 SET XMSUB="2421 Request "_RMPRREF_" for Work Order # "_RMPRWO_" has been Canceled"
SET RTX(1)="2421 Request "_RMPRREF_" for Work Order # "_RMPRWO_" has been Canceled"
+3 SET RTX(2)="BY: "_$$EMP^RMPR31U(DUZ)
+4 SET PEMP=$PIECE(^RMPR(664.1,RDA,0),U,16)
IF +PEMP>0
SET XMY(PEMP)=""
+5 FOR RI=0:0
SET RI=$ORDER(^RMPR(664.1,RDA,2,RI))
if RI'>0
QUIT
IF $DATA(^(RI,0))
SET RDA=^(0)
SET RA=$PIECE(RDA,U,5)
Begin DoDot:1
+6 FOR DA=0:0
SET DA=$ORDER(^RMPR(664.3,"C",RA,DA))
if DA'>0
QUIT
IF $DATA(^RMPR(664.3,DA))
FOR RU=0:0
SET RU=$ORDER(^RMPR(664.3,DA,1,RU))
if RU'>0
QUIT
IF $DATA(^(RU,0))
SET PEMP=$PIECE(^(0),U)
IF PEMP>0
SET XMY(PEMP)=""
End DoDot:1
+7 DO SUP
IF $DATA(XMY)
SET XMTEXT="RTX("
DO ^XMD
KILL XMY,RTX
+8 QUIT
DA0(RDA,PDA) ;DELIVER 2421
+1 if '$DATA(^RMPR(664.1,RDA,0))
QUIT
NEW RMPRWO,RMPRREF
SET RMPRWO=$PIECE(^RMPR(664.1,RDA,0),U,13)
SET RMPRREF=$PIECE($GET(^RMPR(664,PDA,0)),U,7)
KILL XMY
+2 SET XMSUB="2421 Request "_RMPRREF_" for Work Order # "_RMPRWO_" has been Delivered"
+3 SET RTX(1)="The 2421 Request "_RMPRREF_"has been closed out,"
+4 SET RTX(2)="by "_$$EMP^RMPR31U(DUZ)_"."
+5 SET RTX(3)=" "
+6 SET RTX(4)="This is associated with Work Order # "_RMPRWO_","
+7 SET RTX(5)="assigned to technician "_$PIECE(^VA(200,$PIECE(^RMPR(664.1,RDA,0),U,16),0),U,1)_"."
+8 SET PEMP=$PIECE(^RMPR(664.1,RDA,0),U,16)
IF +PEMP>0
SET XMY(PEMP)=""
+9 FOR RI=0:0
SET RI=$ORDER(^RMPR(664.1,RDA,2,RI))
if RI'>0
QUIT
IF $DATA(^(RI,0))
SET RDA=^(0)
SET RA=$PIECE(RDA,U,5)
Begin DoDot:1
+10 FOR DA=0:0
SET DA=$ORDER(^RMPR(664.3,"C",RA,DA))
if DA'>0
QUIT
IF $DATA(^RMPR(664.3,DA))
FOR RU=0:0
SET RU=$ORDER(^RMPR(664.3,DA,1,RU))
if RU'>0
QUIT
IF $DATA(^(RU,0))
SET PEMP=$PIECE(^(0),U)
IF PEMP>0
SET XMY(PEMP)=""
End DoDot:1
+11 DO SUP
IF $DATA(XMY)
SET XMTEXT="RTX("
DO ^XMD
KILL XMY,RTX
+12 QUIT
DEL(PDA) ;DELETED 2421 REQUEST
+1 if ('$DATA(^RMPR(664,PDA,0)))
QUIT
KILL XMY
NEW RMPRWO
SET RMPRWO=$PIECE($GET(^RMPR(664.2,+$PIECE(^(0),U,15),0)),U)
IF $PIECE(^RMPR(664,PDA,0),U,16)
SET XMY($PIECE(^(0),U,16))=""
+2 SET DIE="^RMPR(664,"
SET DA=RMPRA
SET DR="24"
DO ^DIE
SET XMSUB="2421 Request for Work Order # "_RMPRWO_" Has been Deleted"
SET RTX(1)=XMSUB
SET RTX(2)="BY: "_$$EMP^RMPR31U(DUZ)
+3 FOR RW=0:0
SET RW=$ORDER(^RMPR(664,PDA,4,RW))
if RW'>0
QUIT
IF $DATA(^(RW,0))
SET RTX(RW+3)=^(0)
+4 DO SUP
IF $DATA(XMY)
SET XMTEXT="RTX("
DO ^XMD
KILL XMY,RTX
+5 QUIT
SLK ;SETUP DIC("S") FOR LABOR HOURS
+1 ;see internal notes
+2 ;CALLED FROM RMPR29B
+3 ;VARIABLES REQUIRED: + Y
+4 SET DIC("S")="I $P(^RMPR(664.3,+Y,0),U,2)=DA660"
SET DIC("W")="F ZI=0:0 S ZI=$O(^RMPR(664.3,+Y,1,ZI)) Q:+ZI'>0 I $D(^(ZI,0)) W ?40,$$EMP^RMPR31U($P(^(0),U)) I $O(^RMPR(664.3,+Y,1,ZI)) W !"
SET DLAYGO=664.3
SET DIC="^RMPR(664.3,"
SET DIC(0)="QML"
QUIT
+5 QUIT
PAP ;PURCHASE APPROVAL
+1 QUIT
+2 ;N RMPR90I
+3 ;D DIV4^RMPRSIT
+4 ;I '$D(^XUSEC("RMPRSUPERVISOR",DUZ)) Q
+5 ;S CNT=0 S RMPR90I=0 F S RMPR90I=$O(^RMPR(664,"AP",RMPR("STA"),RMPR90I)) Q:RMPR90I'>0 S CNT=CNT+1
+6 ;I +CNT W !!,?5,$C(7),"There "_$S(CNT>1:"are ",1:"is ")_CNT_" Purchase Request(s) Pending Approval"
+7 ;Q
