source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR29S.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.6 KB
Line 
1RMPR29S ;PHX/JLT-ASSIGN WORK ORDER[ 09/30/94 3:55 PM ]
2 ;;3.0;PROSTHETICS;**50**;Feb 09, 1996
3 ;
4 ;ODJ - Patch 50 - 7/13/00 - put in call to set patient vars. to
5 ; prevent undef errs. cf nois MIW-1098-41197
6 ;
7ASK ;ASK FOR MUTLIPLE ASSGIN
8 D DIV4^RMPRSIT G:$D(X) EXIT
9 S DIR(0)="Y",DIR("A")="Would you like assign Multiple 2529-3's",DIR("B")="YES" D ^DIR G:$D(DIRUT)!($D(DTOUT)) EXIT I +Y=1 S PCOUNT=0 G MUL
10APP ;ASSIGN SINGLE 2529-3 TO TECHNICIAN
11 S DIC="^RMPR(664.1,",DIC(0)="AEQM",DIC("S")="I $P(^(0),U,3)=RMPR(""STA""),'$P(^(0),U,20),($P(^(0),U,17)=""P""!($P(^(0),U,17)=""A""))",DIC("W")="D EN3^RMPRD1" D ^DIC G:+Y'>0 EXIT
12 S RMPRDA=+Y,PASS=1
13ASM ;check/lock record
14 ;S RMPRDA=+Y
15 Q:$G(RMPRDA)<1
16 L +^RMPR(664.1,RMPRDA,0):1 I '$T W !!,$C(7),?5,"Someone else is editing this entry" G EXIT
17 S RMPRWO=$P(^RMPR(664.1,RMPRDA,0),U,13) G DISP^RMPR29D
18ATCH ;attach technician/status to record
19 ;CALLED BY RMPR29T
20 ;VARIABLE REQUIRED: RMPRDA - ENTRY NUMBER IN FILE 664.1
21 ; RMPR ARRAY - MISCELLANEOUS SITE DATASET BY
22 ; A CALL TO DIV4^RMPRSIT
23 ; RMPR("L") - A LINE OF DIRECTIONS
24 K DIC,Y S DIC("B")=$S($P(^RMPR(664.1,+RMPRDA,0),U,16):$$EMP^RMPR31U($P(^(0),U,16)),1:""),DIC="^VA(200,",DIC(0)="AEQMZ",DIC("A")="LAB TECHNICIAN: " D ^DIC G:+Y'>0 EXIT S PEMP=+Y D ST^RMPR29U
25 S DIE="^RMPR(664.1,",DR=$S($P($G(^RMPR(664.1,RMPRDA,7)),U):"19R",1:"19R///^S X=DT"),DA=RMPRDA D ^DIE G:$D(DTOUT)!($D(Y)) EXIT
26 G DISP^RMPR29D
27EXIT ;common exit point
28 ;CALLED BY RMPR29T
29 L -^RMPR(664.1,+$G(RMPRDA),0)
30 K DIC,DIE,DIR,DA,DIRUT,DR,DTOUT,PEMP,PREV,PSM,RMPRDA,RMPRDFN,RMPRWO,RI
31 K PASS,PCOUNT Q
32MUL ;MULTIPLE ASSIGN
33 S RMPRBAC1=1
34 K PDCA F RI=0:0 S RI=$O(^RMPR(664.1,"E","P",RI)) Q:+RI'>0 I +RI,$P($G(^RMPR(664.1,RI,0)),U,3)=RMPR("STA") S PDCA(RI)="",PREV(-RI)=""
35 I '$D(PDCA) D MESS G EXIT
36 S PCOUNT=$O(PDCA(PCOUNT)) G:$G(PCOUNT)<1 EXIT
37 I +PCOUNT S Y=PCOUNT,RMPRDA=Y,PSM=1
38 D ASM
39 Q
40NEXT ;LOOK THRU EXITING 2529-3's
41 ;CALLED BY RMPR29T
42 ;VARIABLES REQUIRED: PDCA - AN ARRAY
43 ; RMPRDA - ENTRY IN FILE 664
44 ; PCOUNT - AN INDEX
45 ; RMPR ARRAY - MISCELLANEOUS SET BY
46 ; A CALL TO DIV4^RMPRSIT
47 ;I +$O(PDCA(RMPRDA))=0 W $C(7) S Y=RMPRDA G ASM
48 ;S PCOUNT=$O(PDCA(PCOUNT)) I +PCOUNT S Y=PCOUNT G ASM
49 I +$O(PDCA(RMPRDA))=0 W $C(7),!!,"There are no more 'next' jobs to assign." H 2 Q ;G ASM
50 S RMPRDA=$O(PDCA(RMPRDA)) I $G(RMPRDA)>0 G ASM
51 Q
52PREV ;previous record
53 ;CALLED BY RMPR29T
54 ;VARIABLE REQUIRED: RMPRDA - SUPSCRIPT IN PREV ARRAY
55 ; PREV - AN ARRAY
56 I +$O(PREV(-RMPRDA))=0 W $C(7) S Y=RMPRDA G ASM
57 S Y=$O(PREV(-RMPRDA)) I $G(Y)'="" S (PCOUNT,Y)=Y*-1,PSM=1,RMPRDA=Y G ASM
58 Q
59MESS ;message/pause
60 W !!,$C(7),?5,"No Lab 2529-3's need to be assigned" H 3
61 Q
62PRC ;entry point from option RMPR PROCESS 2529-3 JOB
63 ;PROCESS 2529-3 TO CREATE WORK ORDER
64 ;CALLED BY RMPR29A
65 ;VARIABLES REQUIRED: NONE
66 D KVAR^VADPT,HOME^%ZIS K X,Y,DIC
67 D DIV4^RMPRSIT G:$D(X) EXIT
68 S DIC="^RMPR(664.1,",DIC(0)="AEQM"
69 ;screen
70 ;if STATION = site selected
71 ;if WORK ORDER NUMBER not null
72 ;if NO LAB COUNT null
73 ;if STATUS "A" Assigned to tech
74 S DIC("S")="I $P(^(0),U,3)=RMPR(""STA""),$P(^(0),U,13)'="""",'$P(^(0),U,20),($P(^(0),U,17)=""A"""
75 S DIC("W")="D EN3^RMPRD1"
76 ;change to screen
77 ;if supervisor key, add to screen
78 ;if STATUS = "R" returned to tech
79 ;if STATUS = "PC" pending completion
80 ;if STATUS = "P" pending assignment
81 ;or if not supervisor key, add to screen
82 ;if STATUS = "R"
83 S DIC("S")=$S($D(^XUSEC("RMPR LAB SUPERVISOR",DUZ)):DIC("S")_"!($P(^(0),U,17)=""R"")!($P(^(0),U,17)=""PC"")!($P(^(0),U,17)=""P""))",1:DIC("S")_"!($P(^(0),U,17)=""R""))")
84 D ^DIC S:+Y RMPRDA=+Y K DIC G:+Y'>0 EXIT
85 ;
86 L +^RMPR(664.1,+Y,0):1 I '$T W !!,?5,$C(7),"Someone is already editing this entry" G EXIT
87 S RMPRDFN=$P(^RMPR(664.1,+Y,0),U,2) I '$P(^(0),U,16) S RMPRWO=$P(^(0),U,13)
88 D ;preserve value of $T
89 . D DPTVARS(RMPRDFN) ; set patient vars. required for display later on
90 . Q
91 I S DIR(0)="Y",DIR("A")="You are self Assigning WORK ORDER #: "_RMPRWO_" ",DIR("B")="YES"
92 ;if TECHNICIAN null
93 I W !! D ^DIR G:$D(DIRUT)!($D(DTOUT))!(+Y=0) EXIT I +Y=1 D EN4^RMPR29U(RMPRDA) S PEMP=DUZ S DIE="^RMPR(664.1,",DA=RMPRDA,DR="19///^S X=DT" D ^DIE D ST^RMPR29U G DISP^RMPR29D
94 D EN4^RMPR29U(RMPRDA) G DISP^RMPR29D
95 ;exit from RMPR29D
96 ;
97 ; Get patient vars using same code as in RMPRUTIL
98DPTVARS(DFN) ;
99 N VADM,VAEL
100 D DEM^VADPT
101 D ELIG^VADPT
102 ;set prosthetic variables
103 ;rmprssn is number nnnnnnnnn
104 ;rmprssne is external format of ssn nnn-nn-nnnn
105 S RMPRNAM=$P(VADM(1),U),RMPRSSN=$P(VADM(2),U)
106 S RMPRDOB=$P(VADM(3),U),RMPRSSNE=VA("PID")
107 S RMPRCNUM=VAEL(7)
108 Q
Note: See TracBrowser for help on using the repository browser.