97 lines
2.9 KiB
Mathematica
97 lines
2.9 KiB
Mathematica
RMPREOL ;HINES/RVD SUSPENSE PROCESSING/LINK TO 2319 ; 14-AUG-2001
|
|
;;3.0;PROSTHETICS;**62**;Feb 09, 1996
|
|
;
|
|
; RVD patch #62 - new routine for suspense list template.
|
|
; if link to 2319 record is needed.
|
|
EN ; -- main entry point for RMPREO
|
|
D ^%ZISC
|
|
N STRING,CLREND,COLUMN,LINE,ON,OFF
|
|
;get patient to test with
|
|
K ^TMP($J,"RMPREO")
|
|
K ^TMP($J,"RMPREOEE")
|
|
;ask station
|
|
I '$D(RMPR) D DIV4^RMPRSIT Q:$D(X)
|
|
I '$D(RMPRDFN) D GETPAT^RMPRUTIL Q:'$D(RMPRDFN)
|
|
D EN^VALM("RMPREO LINK 2319")
|
|
Q
|
|
;
|
|
HDR ; -- header code
|
|
N VA,VADM
|
|
S DFN=RMPRDFN
|
|
D DEM^VADPT
|
|
;S VALMHDR(1)="Suspense Processing"
|
|
S VALMHDR(1)="Open/Pending/Closed Suspense for "_$$LOWER^VALM1(VADM(1))_" ("_$P(VADM(2),U,2)_")"
|
|
D KVAR^VADPT
|
|
K ^TMP($J,"RMPREO"),^TMP($J,"RMPREOEE")
|
|
Q
|
|
;
|
|
INIT ; -- init variables and list array
|
|
K ^TMP($J,"RMPREO"),^TMP($J,"RMPREOEE")
|
|
D HDR
|
|
N RMPRA,CDATE,LINE,X
|
|
;start loop
|
|
;
|
|
K ADATE,PDAY
|
|
S RMPRA="",VALMCNT=0,RRX=""
|
|
;reverse order display
|
|
F S RMPRA=$O(^RMPR(668,"C",RMPRDFN,RMPRA),-1) Q:RMPRA="" D
|
|
.I $P(^RMPR(668,RMPRA,0),U,10)="X" Q
|
|
.I $G(RMSUCLFG),'$D(RM68LINK(RMPRA)) Q
|
|
.S VALMCNT=VALMCNT+1,LINE=VALMCNT
|
|
.S RRX=$$SETFLD^VALM1(LINE,RRX,"LINE")
|
|
.S CDATE=$P(^RMPR(668,RMPRA,0),U,1),CDATE=$$DAT1^RMPRUTL1(CDATE)
|
|
.S RRX=$$SETFLD^VALM1(CDATE,RRX,"DATE")
|
|
.S WHO1=""
|
|
.I $P(^RMPR(668,RMPRA,0),U,11)'="" S WHO1=$$WHO^RMPREOU($P(^RMPR(668,RMPRA,0),U,11),12)
|
|
.;I WHO1'="" S RRX=$$SETFLD^VALM1(WHO1,RRX,"WHO")
|
|
.S RRX=$$SETFLD^VALM1(WHO1,RRX,"WHO")
|
|
.K WHO,WHO1
|
|
.;type
|
|
.S TYPE=$$TYPE^RMPREOU(RMPRA,8)
|
|
.S RRX=$$SETFLD^VALM1(TYPE,RRX,"TYPE")
|
|
.;display description if manual
|
|
.;
|
|
.S RRX=$$SETFLD^VALM1($$DES^RMPREOU(RMPRA,22),RRX,"DES")
|
|
.;init activation date
|
|
.S ADATE="",PDAY="",WRKDAY=""
|
|
.S ADATE=$P(^RMPR(668,RMPRA,0),U,9)
|
|
.I ADATE'="" S (PDAY,WRKDAY)=$$WRKDAY^RMPREOU(RMPRA)
|
|
.I ADATE="" S (PDAY,WRKDAY)=$$CWRKDAY^RMPREOU(RMPRA)
|
|
.S RRX=$$SETFLD^VALM1($$DAT1^RMPRUTL1(ADATE),RRX,"INITIAL ACTION DATE")
|
|
.I ADATE'="" S CDAY=$$PDAY^RMPREOU(RMPRA) I CDAY>7 S PDAY="*"_WRKDAY
|
|
.I ADATE=""&(WRKDAY>5) S PDAY="@"_WRKDAY
|
|
.S RRX=$$SETFLD^VALM1(PDAY,RRX,"PDAY")
|
|
.K ADATE,PDAY,WRKDAY,CDAY
|
|
.;S R660=""
|
|
.;F S R660=$O(^RMPR(668,RMPRA,6,"B",R660)) Q:R660'>0 D
|
|
.; .S RRX=$$SETFLD^VALM1($$ITEM^RMPREOU(R660,17),RRX,"ITEM")
|
|
.S RRX=$$SETFLD^VALM1($$STATUS^RMPREOU(RMPRA,7),RRX,"STATUS")
|
|
.S ^TMP($J,"RMPREO",LINE,0)=RRX
|
|
.S ^TMP($J,"RMPREOEE",LINE,0)=RMPRA
|
|
Q
|
|
;
|
|
;
|
|
SET(STRING,LINE,COLUMN,CLREND,ON,OFF) ;set array
|
|
I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
|
|
D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLUMN,CLREND))
|
|
I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLUMN,$L(STRING),ON,OFF)
|
|
Q
|
|
;
|
|
;
|
|
HELP ; -- help code
|
|
S X="?" D DISP^XQORM1 W !!
|
|
Q
|
|
;
|
|
EXIT ; -- exit code
|
|
;NOT XUSCLEAN
|
|
;added by patch #62
|
|
;if transaction still exist for linking, print message and re-link
|
|
I $D(^TMP($J,"RMPRPCE")) D G:RMENTSUS="L" EN
|
|
.S RMQUIT=0
|
|
.W @IOF D SMESS0^RMPRPCEL,CDIR^RMPRPCEL
|
|
K ^TMP($J,"RMPREO"),^TMP($J,"RMPREOEE")
|
|
Q
|
|
;
|
|
EXPND ; -- expand code
|
|
Q
|