| 1 | RMPR29S ;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 | ;
|
|---|
| 7 | ASK ;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
|
|---|
| 10 | APP ;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
|
|---|
| 13 | ASM ;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
|
|---|
| 18 | ATCH ;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
|
|---|
| 27 | EXIT ;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
|
|---|
| 32 | MUL ;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
|
|---|
| 40 | NEXT ;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
|
|---|
| 52 | PREV ;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
|
|---|
| 59 | MESS ;message/pause
|
|---|
| 60 | W !!,$C(7),?5,"No Lab 2529-3's need to be assigned" H 3
|
|---|
| 61 | Q
|
|---|
| 62 | PRC ;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
|
|---|
| 98 | DPTVARS(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
|
|---|
