source: FOIAVistA/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPREO.m@ 1765

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

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1RMPREO ;HINES/HNC SUSPENSE PROCESSING ; 25-JAN-2000
2 ;;3.0;PROSTHETICS;**45,55**;Feb 09, 1996
3EN ; -- main entry point for RMPREO
4 D ^%ZISC
5 N STRING,CLREND,COLUMN,LINE,ON,OFF
6 ;get patient to test with
7 K ^TMP($J,"RMPREO")
8 K ^TMP($J,"RMPREOEE")
9 ;ask station
10 I '$D(RMPR) D DIV4^RMPRSIT Q:$D(X)
11 I '$D(RMPRDFN) D GETPAT^RMPRUTIL Q:'$D(RMPRDFN)
12 D EN^VALM("RMPREO")
13 Q
14 ;
15HDR ; -- header code
16 N VA,VADM
17 S DFN=RMPRDFN
18 D DEM^VADPT
19 ;S VALMHDR(1)="Suspense Processing"
20 S VALMHDR(1)="Open/Pending/Closed Suspense for "_$$LOWER^VALM1(VADM(1))_" ("_$P(VADM(2),U,2)_")"
21 D KVAR^VADPT
22 Q
23 ;
24INIT ; -- init variables and list array
25 K ^TMP($J,"RMPREO"),^TMP($J,"RMPREOEE")
26 D HDR
27 N RMPRA,CDATE,LINE,X
28 ;start loop
29 ;
30 K ADATE,PDAY
31 S RMPRA="",VALMCNT=0,RRX=""
32 ;reverse order display
33 F S RMPRA=$O(^RMPR(668,"C",RMPRDFN,RMPRA),-1) Q:RMPRA="" D
34 .I $P(^RMPR(668,RMPRA,0),U,10)="X" Q
35 .S VALMCNT=VALMCNT+1,LINE=VALMCNT
36 .S RRX=$$SETFLD^VALM1(LINE,RRX,"LINE")
37 .S CDATE=$P(^RMPR(668,RMPRA,0),U,1),CDATE=$$DAT1^RMPRUTL1(CDATE)
38 .S RRX=$$SETFLD^VALM1(CDATE,RRX,"DATE")
39 .S WHO1=""
40 .I $P(^RMPR(668,RMPRA,0),U,11)'="" S WHO1=$$WHO^RMPREOU($P(^RMPR(668,RMPRA,0),U,11),12)
41 .;I WHO1'="" S RRX=$$SETFLD^VALM1(WHO1,RRX,"WHO")
42 .S RRX=$$SETFLD^VALM1(WHO1,RRX,"WHO")
43 .K WHO,WHO1
44 .;type
45 .S TYPE=$$TYPE^RMPREOU(RMPRA,8)
46 .S RRX=$$SETFLD^VALM1(TYPE,RRX,"TYPE")
47 .;display description if manual
48 .;
49 .S RRX=$$SETFLD^VALM1($$DES^RMPREOU(RMPRA,22),RRX,"DES")
50 .;init activation date
51 .S ADATE="",PDAY="",WRKDAY=""
52 .S ADATE=$P(^RMPR(668,RMPRA,0),U,9)
53 .I ADATE'="" S (PDAY,WRKDAY)=$$WRKDAY^RMPREOU(RMPRA)
54 .I ADATE="" S (PDAY,WRKDAY)=$$CWRKDAY^RMPREOU(RMPRA)
55 .S RRX=$$SETFLD^VALM1($$DAT1^RMPRUTL1(ADATE),RRX,"INITIAL ACTION DATE")
56 .I ADATE'="" S CDAY=$$PDAY^RMPREOU(RMPRA) I CDAY>7 S PDAY="*"_WRKDAY
57 .I ADATE=""&(WRKDAY>5) S PDAY="@"_WRKDAY
58 .S RRX=$$SETFLD^VALM1(PDAY,RRX,"PDAY")
59 .K ADATE,PDAY,WRKDAY,CDAY
60 .;S R660=""
61 .;F S R660=$O(^RMPR(668,RMPRA,6,"B",R660)) Q:R660'>0 D
62 .; .S RRX=$$SETFLD^VALM1($$ITEM^RMPREOU(R660,17),RRX,"ITEM")
63 .S RRX=$$SETFLD^VALM1($$STATUS^RMPREOU(RMPRA,7),RRX,"STATUS")
64 .S ^TMP($J,"RMPREO",LINE,0)=RRX
65 .S ^TMP($J,"RMPREOEE",LINE,0)=RMPRA
66 Q
67 ;
68 ;
69SET(STRING,LINE,COLUMN,CLREND,ON,OFF) ;set array
70 I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
71 D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLUMN,CLREND))
72 I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLUMN,$L(STRING),ON,OFF)
73 Q
74 ;
75 ;
76HELP ; -- help code
77 S X="?" D DISP^XQORM1 W !!
78 Q
79 ;
80EXIT ; -- exit code
81 ;NOT XUSCLEAN
82 K ^TMP($J,"RMPREO")
83 K RMPRDFN
84 Q
85 ;
86EXPND ; -- expand code
87 Q
88 ;
Note: See TracBrowser for help on using the repository browser.