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

RMPR29S.m

Go to the documentation of this file.
  1. RMPR29S ;PHX/JLT-ASSIGN WORK ORDER[ 09/30/94 3:55 PM ]
  1. ;;3.0;PROSTHETICS;**50**;Feb 09, 1996
  1. ;
  1. ;ODJ - Patch 50 - 7/13/00 - put in call to set patient vars. to
  1. ; prevent undef errs. cf nois MIW-1098-41197
  1. ;
  1. ASK ;ASK FOR MUTLIPLE ASSGIN
  1. D DIV4^RMPRSIT G:$D(X) EXIT
  1. 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
  1. APP ;ASSIGN SINGLE 2529-3 TO TECHNICIAN
  1. 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
  1. S RMPRDA=+Y,PASS=1
  1. ASM ;check/lock record
  1. ;S RMPRDA=+Y
  1. Q:$G(RMPRDA)<1
  1. L +^RMPR(664.1,RMPRDA,0):1 I '$T W !!,$C(7),?5,"Someone else is editing this entry" G EXIT
  1. S RMPRWO=$P(^RMPR(664.1,RMPRDA,0),U,13) G DISP^RMPR29D
  1. ATCH ;attach technician/status to record
  1. ;CALLED BY RMPR29T
  1. ;VARIABLE REQUIRED: RMPRDA - ENTRY NUMBER IN FILE 664.1
  1. ; RMPR ARRAY - MISCELLANEOUS SITE DATASET BY
  1. ; A CALL TO DIV4^RMPRSIT
  1. ; RMPR("L") - A LINE OF DIRECTIONS
  1. 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
  1. 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
  1. G DISP^RMPR29D
  1. EXIT ;common exit point
  1. ;CALLED BY RMPR29T
  1. L -^RMPR(664.1,+$G(RMPRDA),0)
  1. K DIC,DIE,DIR,DA,DIRUT,DR,DTOUT,PEMP,PREV,PSM,RMPRDA,RMPRDFN,RMPRWO,RI
  1. K PASS,PCOUNT Q
  1. MUL ;MULTIPLE ASSIGN
  1. S RMPRBAC1=1
  1. 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)=""
  1. I '$D(PDCA) D MESS G EXIT
  1. S PCOUNT=$O(PDCA(PCOUNT)) G:$G(PCOUNT)<1 EXIT
  1. I +PCOUNT S Y=PCOUNT,RMPRDA=Y,PSM=1
  1. D ASM
  1. Q
  1. NEXT ;LOOK THRU EXITING 2529-3's
  1. ;CALLED BY RMPR29T
  1. ;VARIABLES REQUIRED: PDCA - AN ARRAY
  1. ; RMPRDA - ENTRY IN FILE 664
  1. ; PCOUNT - AN INDEX
  1. ; RMPR ARRAY - MISCELLANEOUS SET BY
  1. ; A CALL TO DIV4^RMPRSIT
  1. ;I +$O(PDCA(RMPRDA))=0 W $C(7) S Y=RMPRDA G ASM
  1. ;S PCOUNT=$O(PDCA(PCOUNT)) I +PCOUNT S Y=PCOUNT G ASM
  1. I +$O(PDCA(RMPRDA))=0 W $C(7),!!,"There are no more 'next' jobs to assign." H 2 Q ;G ASM
  1. S RMPRDA=$O(PDCA(RMPRDA)) I $G(RMPRDA)>0 G ASM
  1. Q
  1. PREV ;previous record
  1. ;CALLED BY RMPR29T
  1. ;VARIABLE REQUIRED: RMPRDA - SUPSCRIPT IN PREV ARRAY
  1. ; PREV - AN ARRAY
  1. I +$O(PREV(-RMPRDA))=0 W $C(7) S Y=RMPRDA G ASM
  1. S Y=$O(PREV(-RMPRDA)) I $G(Y)'="" S (PCOUNT,Y)=Y*-1,PSM=1,RMPRDA=Y G ASM
  1. Q
  1. MESS ;message/pause
  1. W !!,$C(7),?5,"No Lab 2529-3's need to be assigned" H 3
  1. Q
  1. PRC ;entry point from option RMPR PROCESS 2529-3 JOB
  1. ;PROCESS 2529-3 TO CREATE WORK ORDER
  1. ;CALLED BY RMPR29A
  1. ;VARIABLES REQUIRED: NONE
  1. D KVAR^VADPT,HOME^%ZIS K X,Y,DIC
  1. D DIV4^RMPRSIT G:$D(X) EXIT
  1. S DIC="^RMPR(664.1,",DIC(0)="AEQM"
  1. ;screen
  1. ;if STATION = site selected
  1. ;if WORK ORDER NUMBER not null
  1. ;if NO LAB COUNT null
  1. ;if STATUS "A" Assigned to tech
  1. S DIC("S")="I $P(^(0),U,3)=RMPR(""STA""),$P(^(0),U,13)'="""",'$P(^(0),U,20),($P(^(0),U,17)=""A"""
  1. S DIC("W")="D EN3^RMPRD1"
  1. ;change to screen
  1. ;if supervisor key, add to screen
  1. ;if STATUS = "R" returned to tech
  1. ;if STATUS = "PC" pending completion
  1. ;if STATUS = "P" pending assignment
  1. ;or if not supervisor key, add to screen
  1. ;if STATUS = "R"
  1. 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""))")
  1. D ^DIC S:+Y RMPRDA=+Y K DIC G:+Y'>0 EXIT
  1. ;
  1. L +^RMPR(664.1,+Y,0):1 I '$T W !!,?5,$C(7),"Someone is already editing this entry" G EXIT
  1. S RMPRDFN=$P(^RMPR(664.1,+Y,0),U,2) I '$P(^(0),U,16) S RMPRWO=$P(^(0),U,13)
  1. D ;preserve value of $T
  1. . D DPTVARS(RMPRDFN) ; set patient vars. required for display later on
  1. . Q
  1. I S DIR(0)="Y",DIR("A")="You are self Assigning WORK ORDER #: "_RMPRWO_" ",DIR("B")="YES"
  1. ;if TECHNICIAN null
  1. 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
  1. D EN4^RMPR29U(RMPRDA) G DISP^RMPR29D
  1. ;exit from RMPR29D
  1. ;
  1. ; Get patient vars using same code as in RMPRUTIL
  1. DPTVARS(DFN) ;
  1. N VADM,VAEL
  1. D DEM^VADPT
  1. D ELIG^VADPT
  1. ;set prosthetic variables
  1. ;rmprssn is number nnnnnnnnn
  1. ;rmprssne is external format of ssn nnn-nn-nnnn
  1. S RMPRNAM=$P(VADM(1),U),RMPRSSN=$P(VADM(2),U)
  1. S RMPRDOB=$P(VADM(3),U),RMPRSSNE=VA("PID")
  1. S RMPRCNUM=VAEL(7)
  1. Q