- RMPR29S ;PHX/JLT-ASSIGN WORK ORDER[ 09/30/94 3:55 PM ]
- ;;3.0;PROSTHETICS;**50**;Feb 09, 1996
- ;
- ;ODJ - Patch 50 - 7/13/00 - put in call to set patient vars. to
- ; prevent undef errs. cf nois MIW-1098-41197
- ;
- ASK ;ASK FOR MUTLIPLE ASSGIN
- D DIV4^RMPRSIT G:$D(X) EXIT
- 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
- APP ;ASSIGN SINGLE 2529-3 TO TECHNICIAN
- 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
- S RMPRDA=+Y,PASS=1
- ASM ;check/lock record
- ;S RMPRDA=+Y
- Q:$G(RMPRDA)<1
- L +^RMPR(664.1,RMPRDA,0):1 I '$T W !!,$C(7),?5,"Someone else is editing this entry" G EXIT
- S RMPRWO=$P(^RMPR(664.1,RMPRDA,0),U,13) G DISP^RMPR29D
- ATCH ;attach technician/status to record
- ;CALLED BY RMPR29T
- ;VARIABLE REQUIRED: RMPRDA - ENTRY NUMBER IN FILE 664.1
- ; RMPR ARRAY - MISCELLANEOUS SITE DATASET BY
- ; A CALL TO DIV4^RMPRSIT
- ; RMPR("L") - A LINE OF DIRECTIONS
- 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
- 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
- G DISP^RMPR29D
- EXIT ;common exit point
- ;CALLED BY RMPR29T
- L -^RMPR(664.1,+$G(RMPRDA),0)
- K DIC,DIE,DIR,DA,DIRUT,DR,DTOUT,PEMP,PREV,PSM,RMPRDA,RMPRDFN,RMPRWO,RI
- K PASS,PCOUNT Q
- MUL ;MULTIPLE ASSIGN
- S RMPRBAC1=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)=""
- I '$D(PDCA) D MESS G EXIT
- S PCOUNT=$O(PDCA(PCOUNT)) G:$G(PCOUNT)<1 EXIT
- I +PCOUNT S Y=PCOUNT,RMPRDA=Y,PSM=1
- D ASM
- Q
- NEXT ;LOOK THRU EXITING 2529-3's
- ;CALLED BY RMPR29T
- ;VARIABLES REQUIRED: PDCA - AN ARRAY
- ; RMPRDA - ENTRY IN FILE 664
- ; PCOUNT - AN INDEX
- ; RMPR ARRAY - MISCELLANEOUS SET BY
- ; A CALL TO DIV4^RMPRSIT
- ;I +$O(PDCA(RMPRDA))=0 W $C(7) S Y=RMPRDA G ASM
- ;S PCOUNT=$O(PDCA(PCOUNT)) I +PCOUNT S Y=PCOUNT G ASM
- I +$O(PDCA(RMPRDA))=0 W $C(7),!!,"There are no more 'next' jobs to assign." H 2 Q ;G ASM
- S RMPRDA=$O(PDCA(RMPRDA)) I $G(RMPRDA)>0 G ASM
- Q
- PREV ;previous record
- ;CALLED BY RMPR29T
- ;VARIABLE REQUIRED: RMPRDA - SUPSCRIPT IN PREV ARRAY
- ; PREV - AN ARRAY
- I +$O(PREV(-RMPRDA))=0 W $C(7) S Y=RMPRDA G ASM
- S Y=$O(PREV(-RMPRDA)) I $G(Y)'="" S (PCOUNT,Y)=Y*-1,PSM=1,RMPRDA=Y G ASM
- Q
- MESS ;message/pause
- W !!,$C(7),?5,"No Lab 2529-3's need to be assigned" H 3
- Q
- PRC ;entry point from option RMPR PROCESS 2529-3 JOB
- ;PROCESS 2529-3 TO CREATE WORK ORDER
- ;CALLED BY RMPR29A
- ;VARIABLES REQUIRED: NONE
- D KVAR^VADPT,HOME^%ZIS K X,Y,DIC
- D DIV4^RMPRSIT G:$D(X) EXIT
- S DIC="^RMPR(664.1,",DIC(0)="AEQM"
- ;screen
- ;if STATION = site selected
- ;if WORK ORDER NUMBER not null
- ;if NO LAB COUNT null
- ;if STATUS "A" Assigned to tech
- S DIC("S")="I $P(^(0),U,3)=RMPR(""STA""),$P(^(0),U,13)'="""",'$P(^(0),U,20),($P(^(0),U,17)=""A"""
- S DIC("W")="D EN3^RMPRD1"
- ;change to screen
- ;if supervisor key, add to screen
- ;if STATUS = "R" returned to tech
- ;if STATUS = "PC" pending completion
- ;if STATUS = "P" pending assignment
- ;or if not supervisor key, add to screen
- ;if STATUS = "R"
- 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""))")
- D ^DIC S:+Y RMPRDA=+Y K DIC G:+Y'>0 EXIT
- ;
- L +^RMPR(664.1,+Y,0):1 I '$T W !!,?5,$C(7),"Someone is already editing this entry" G EXIT
- S RMPRDFN=$P(^RMPR(664.1,+Y,0),U,2) I '$P(^(0),U,16) S RMPRWO=$P(^(0),U,13)
- D ;preserve value of $T
- . D DPTVARS(RMPRDFN) ; set patient vars. required for display later on
- . Q
- I S DIR(0)="Y",DIR("A")="You are self Assigning WORK ORDER #: "_RMPRWO_" ",DIR("B")="YES"
- ;if TECHNICIAN null
- 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
- D EN4^RMPR29U(RMPRDA) G DISP^RMPR29D
- ;exit from RMPR29D
- ;
- ; Get patient vars using same code as in RMPRUTIL
- DPTVARS(DFN) ;
- N VADM,VAEL
- D DEM^VADPT
- D ELIG^VADPT
- ;set prosthetic variables
- ;rmprssn is number nnnnnnnnn
- ;rmprssne is external format of ssn nnn-nn-nnnn
- S RMPRNAM=$P(VADM(1),U),RMPRSSN=$P(VADM(2),U)
- S RMPRDOB=$P(VADM(3),U),RMPRSSNE=VA("PID")
- S RMPRCNUM=VAEL(7)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR29S 4824 printed Feb 18, 2025@23:58:56 Page 2
- RMPR29S ;PHX/JLT-ASSIGN WORK ORDER[ 09/30/94 3:55 PM ]
- +1 ;;3.0;PROSTHETICS;**50**;Feb 09, 1996
- +2 ;
- +3 ;ODJ - Patch 50 - 7/13/00 - put in call to set patient vars. to
- +4 ; prevent undef errs. cf nois MIW-1098-41197
- +5 ;
- ASK ;ASK FOR MUTLIPLE ASSGIN
- +1 DO DIV4^RMPRSIT
- if $DATA(X)
- GOTO EXIT
- +2 SET DIR(0)="Y"
- SET DIR("A")="Would you like assign Multiple 2529-3's"
- SET DIR("B")="YES"
- DO ^DIR
- if $DATA(DIRUT)!($DATA(DTOUT))
- GOTO EXIT
- IF +Y=1
- SET PCOUNT=0
- GOTO MUL
- APP ;ASSIGN SINGLE 2529-3 TO TECHNICIAN
- +1 SET DIC="^RMPR(664.1,"
- SET DIC(0)="AEQM"
- SET DIC("S")="I $P(^(0),U,3)=RMPR(""STA""),'$P(^(0),U,20),($P(^(0),U,17)=""P""!($P(^(0),U,17)=""A""))"
- SET DIC("W")="D EN3^RMPRD1"
- DO ^DIC
- if +Y'>0
- GOTO EXIT
- +2 SET RMPRDA=+Y
- SET PASS=1
- ASM ;check/lock record
- +1 ;S RMPRDA=+Y
- +2 if $GET(RMPRDA)<1
- QUIT
- +3 LOCK +^RMPR(664.1,RMPRDA,0):1
- IF '$TEST
- WRITE !!,$CHAR(7),?5,"Someone else is editing this entry"
- GOTO EXIT
- +4 SET RMPRWO=$PIECE(^RMPR(664.1,RMPRDA,0),U,13)
- GOTO DISP^RMPR29D
- ATCH ;attach technician/status to record
- +1 ;CALLED BY RMPR29T
- +2 ;VARIABLE REQUIRED: RMPRDA - ENTRY NUMBER IN FILE 664.1
- +3 ; RMPR ARRAY - MISCELLANEOUS SITE DATASET BY
- +4 ; A CALL TO DIV4^RMPRSIT
- +5 ; RMPR("L") - A LINE OF DIRECTIONS
- +6 KILL DIC,Y
- SET DIC("B")=$SELECT($PIECE(^RMPR(664.1,+RMPRDA,0),U,16):$$EMP^RMPR31U($PIECE(^(0),U,16)),1:"")
- SET DIC="^VA(200,"
- SET DIC(0)="AEQMZ"
- SET DIC("A")="LAB TECHNICIAN: "
- DO ^DIC
- if +Y'>0
- GOTO EXIT
- SET PEMP=+Y
- DO ST^RMPR29U
- +7 SET DIE="^RMPR(664.1,"
- SET DR=$SELECT($PIECE($GET(^RMPR(664.1,RMPRDA,7)),U):"19R",1:"19R///^S X=DT")
- SET DA=RMPRDA
- DO ^DIE
- if $DATA(DTOUT)!($DATA(Y))
- GOTO EXIT
- +8 GOTO DISP^RMPR29D
- EXIT ;common exit point
- +1 ;CALLED BY RMPR29T
- +2 LOCK -^RMPR(664.1,+$GET(RMPRDA),0)
- +3 KILL DIC,DIE,DIR,DA,DIRUT,DR,DTOUT,PEMP,PREV,PSM,RMPRDA,RMPRDFN,RMPRWO,RI
- +4 KILL PASS,PCOUNT
- QUIT
- MUL ;MULTIPLE ASSIGN
- +1 SET RMPRBAC1=1
- +2 KILL PDCA
- FOR RI=0:0
- SET RI=$ORDER(^RMPR(664.1,"E","P",RI))
- if +RI'>0
- QUIT
- IF +RI
- IF $PIECE($GET(^RMPR(664.1,RI,0)),U,3)=RMPR("STA")
- SET PDCA(RI)=""
- SET PREV(-RI)=""
- +3 IF '$DATA(PDCA)
- DO MESS
- GOTO EXIT
- +4 SET PCOUNT=$ORDER(PDCA(PCOUNT))
- if $GET(PCOUNT)<1
- GOTO EXIT
- +5 IF +PCOUNT
- SET Y=PCOUNT
- SET RMPRDA=Y
- SET PSM=1
- +6 DO ASM
- +7 QUIT
- NEXT ;LOOK THRU EXITING 2529-3's
- +1 ;CALLED BY RMPR29T
- +2 ;VARIABLES REQUIRED: PDCA - AN ARRAY
- +3 ; RMPRDA - ENTRY IN FILE 664
- +4 ; PCOUNT - AN INDEX
- +5 ; RMPR ARRAY - MISCELLANEOUS SET BY
- +6 ; A CALL TO DIV4^RMPRSIT
- +7 ;I +$O(PDCA(RMPRDA))=0 W $C(7) S Y=RMPRDA G ASM
- +8 ;S PCOUNT=$O(PDCA(PCOUNT)) I +PCOUNT S Y=PCOUNT G ASM
- +9 ;G ASM
- IF +$ORDER(PDCA(RMPRDA))=0
- WRITE $CHAR(7),!!,"There are no more 'next' jobs to assign."
- HANG 2
- QUIT
- +10 SET RMPRDA=$ORDER(PDCA(RMPRDA))
- IF $GET(RMPRDA)>0
- GOTO ASM
- +11 QUIT
- PREV ;previous record
- +1 ;CALLED BY RMPR29T
- +2 ;VARIABLE REQUIRED: RMPRDA - SUPSCRIPT IN PREV ARRAY
- +3 ; PREV - AN ARRAY
- +4 IF +$ORDER(PREV(-RMPRDA))=0
- WRITE $CHAR(7)
- SET Y=RMPRDA
- GOTO ASM
- +5 SET Y=$ORDER(PREV(-RMPRDA))
- IF $GET(Y)'=""
- SET (PCOUNT,Y)=Y*-1
- SET PSM=1
- SET RMPRDA=Y
- GOTO ASM
- +6 QUIT
- MESS ;message/pause
- +1 WRITE !!,$CHAR(7),?5,"No Lab 2529-3's need to be assigned"
- HANG 3
- +2 QUIT
- PRC ;entry point from option RMPR PROCESS 2529-3 JOB
- +1 ;PROCESS 2529-3 TO CREATE WORK ORDER
- +2 ;CALLED BY RMPR29A
- +3 ;VARIABLES REQUIRED: NONE
- +4 DO KVAR^VADPT
- DO HOME^%ZIS
- KILL X,Y,DIC
- +5 DO DIV4^RMPRSIT
- if $DATA(X)
- GOTO EXIT
- +6 SET DIC="^RMPR(664.1,"
- SET DIC(0)="AEQM"
- +7 ;screen
- +8 ;if STATION = site selected
- +9 ;if WORK ORDER NUMBER not null
- +10 ;if NO LAB COUNT null
- +11 ;if STATUS "A" Assigned to tech
- +12 SET DIC("S")="I $P(^(0),U,3)=RMPR(""STA""),$P(^(0),U,13)'="""",'$P(^(0),U,20),($P(^(0),U,17)=""A"""
- +13 SET DIC("W")="D EN3^RMPRD1"
- +14 ;change to screen
- +15 ;if supervisor key, add to screen
- +16 ;if STATUS = "R" returned to tech
- +17 ;if STATUS = "PC" pending completion
- +18 ;if STATUS = "P" pending assignment
- +19 ;or if not supervisor key, add to screen
- +20 ;if STATUS = "R"
- +21 SET DIC("S")=$SELECT($DATA(^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""))")
- +22 DO ^DIC
- if +Y
- SET RMPRDA=+Y
- KILL DIC
- if +Y'>0
- GOTO EXIT
- +23 ;
- +24 LOCK +^RMPR(664.1,+Y,0):1
- IF '$TEST
- WRITE !!,?5,$CHAR(7),"Someone is already editing this entry"
- GOTO EXIT
- +25 SET RMPRDFN=$PIECE(^RMPR(664.1,+Y,0),U,2)
- IF '$PIECE(^(0),U,16)
- SET RMPRWO=$PIECE(^(0),U,13)
- +26 ;preserve value of $T
- Begin DoDot:1
- +27 ; set patient vars. required for display later on
- DO DPTVARS(RMPRDFN)
- +28 QUIT
- End DoDot:1
- +29 IF $TEST
- SET DIR(0)="Y"
- SET DIR("A")="You are self Assigning WORK ORDER #: "_RMPRWO_" "
- SET DIR("B")="YES"
- +30 ;if TECHNICIAN null
- +31 IF $TEST
- WRITE !!
- DO ^DIR
- if $DATA(DIRUT)!($DATA(DTOUT))!(+Y=0)
- GOTO EXIT
- IF +Y=1
- DO EN4^RMPR29U(RMPRDA)
- SET PEMP=DUZ
- SET DIE="^RMPR(664.1,"
- SET DA=RMPRDA
- SET DR="19///^S X=DT"
- DO ^DIE
- DO ST^RMPR29U
- GOTO DISP^RMPR29D
- +32 DO EN4^RMPR29U(RMPRDA)
- GOTO DISP^RMPR29D
- +33 ;exit from RMPR29D
- +34 ;
- +35 ; Get patient vars using same code as in RMPRUTIL
- DPTVARS(DFN) ;
- +1 NEW VADM,VAEL
- +2 DO DEM^VADPT
- +3 DO ELIG^VADPT
- +4 ;set prosthetic variables
- +5 ;rmprssn is number nnnnnnnnn
- +6 ;rmprssne is external format of ssn nnn-nn-nnnn
- +7 SET RMPRNAM=$PIECE(VADM(1),U)
- SET RMPRSSN=$PIECE(VADM(2),U)
- +8 SET RMPRDOB=$PIECE(VADM(3),U)
- SET RMPRSSNE=VA("PID")
- +9 SET RMPRCNUM=VAEL(7)
- +10 QUIT