source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPEDT12.m@ 861

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1PPPEDT12 ;ALB/JFP - EDIT FF XREF ROUTINE ;5/19/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; These routines control the display of foreign facility
6 ; data via the list processor.
7 ;
8DSPFF(PATDFN) ; List processor entry point
9 ;
10 ; This is the main entry point for calling the list processor.
11 ;
12 ; Parameters:
13 ; PATDFN - The patient internal entry number
14 ;
15 N ARRAYNM,LSTARRAY,IDXARRAY,VALMCNT
16 ;
17 K XQORS,VALMEVL
18 D EN^VALM("PPP XREF EDIT")
19 Q
20 ;
21INIT ; Collect all of the data and build the display array
22 ;
23 N FFXIFN,PPPCNT,ERR
24 ;
25 S ARRAYNM="^TMP(""PPPTMP"",$J)"
26 S LSTARRAY="^TMP(""PPPL1"",$J)"
27 S IDXARRAY="^TMP(""PPPIDX"",$J)"
28 ;
29 K @ARRAYNM,@LSTARRAY,@IDXARRAY
30 ;
31 S (VALMCNT,PPPCNT)=0
32 S FFXIFN=""
33 I '$D(^PPP(1020.2,"B",PATDFN)) D NUL Q
34 F S FFXIFN=$O(^PPP(1020.2,"B",PATDFN,FFXIFN)) Q:FFXIFN="" D
35 .S ERR=$$GETFFX^PPPGET1(FFXIFN,ARRAYNM)
36 .I ERR<0 D Q
37 ..W !,*7,"An Unexpected Error Occurred...check error log"
38 ..R !,"Press <RETURN> to exit...",TMP:DTIME
39 ..S TMP=$$LOGEVNT^PPPMSC1(ERR,"INIT_PPPEDT12","GETFFX")
40 .E D
41 ..; - Format data for display
42 ..S PPPCNT=$$SETD(FFXIFN,ARRAYNM,PPPCNT)
43 ..I PPPCNT<1 D NUL
44 Q
45 ;
46HDR ; Get header data and build it.
47 ;
48 N DIC,DA,DR,DIQ,DUOUT,DTOUT,PPPTMP
49 S DIC="^DPT(",DA=PATDFN,DR=".01;.03;.09",DIQ="PPPTMP" D EN^DIQ1
50 S VALMHDR(1)=""
51 S VALMHDR(2)="Patient: "_PPPTMP(2,PATDFN,.01)_" ("_PPPTMP(2,PATDFN,.09)_") DOB: "_PPPTMP(2,PATDFN,.03)
52 Q
53 ;
54NUL ; Set null message
55 ;
56 S @LSTARRAY@(1,0)=" "
57 S @LSTARRAY@(2,0)=" No Data found for the patient entered..."
58 S @LSTARRAY@(3,0)=""
59 S @LSTARRAY@(4,0)=" Select <AE> - Add Entry to make a NEW entry or <RETURN> to quit"
60 S VALMCNT=4
61 Q
62 ;
63FNL ; Clean Up
64 ;
65 K @ARRAYNM,@LSTARRAY,@IDXARRAY
66 K PPPPNM
67 K DIC,DIE,DR,DA
68 Q
69 ;
70SETD(FFXIFN,TARRY,CNT) ; Sets up display line for list processor
71 ;
72 N PARMERR,TXTLINE
73 ;
74 S PARMERR=-9001
75 ;
76 I '$D(TARRY) Q PARMERR
77 I '$D(CNT) Q PARMERR
78 I '$D(@TARRY@(FFXIFN)) Q PARMERR
79 ;
80 S TXTLINE=" "
81 S CNT=CNT+1
82 S TXTLINE=$$SETFLD^VALM1(CNT,TXTLINE,"ENTRY")
83 S TXTLINE=$$SETFLD^VALM1($G(@TARRY@(FFXIFN,"POV")),TXTLINE,"INST")
84 S TXTLINE=$$SETFLD^VALM1($G(@TARRY@(FFXIFN,"DOMAIN")),TXTLINE,"DOMAIN")
85 S TXTLINE=$$SETFLD^VALM1($G(@TARRY@(FFXIFN,"LVD")),TXTLINE,"LDATE")
86 ;S TXTLINE=$$SETFLD^VALM1($G(@TARRY@(FFXIFN,"ED")),TXTLINE,"EDATE")
87 D SETL
88 Q CNT
89 ;
90SETL ; -- Sets up list manager display array
91 S VALMCNT=VALMCNT+1
92 S @LSTARRAY@(VALMCNT,0)=$E(TXTLINE,1,79)
93 S @LSTARRAY@("IDX",VALMCNT,CNT)=""
94 S @IDXARRAY@(CNT)=VALMCNT_"^"_FFXIFN_"^"_$G(@TARRY@(FFXIFN,"NAME"))_"^"_$G(@TARRY@(FFXIFN,"STANO"))
95 Q
96 ;
97END ; -- End of code
98 Q
99 ;
Note: See TracBrowser for help on using the repository browser.