source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPEDT21.m@ 724

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1PPPEDT21 ;ALB/JFP - EDIT BLANK DOMAIN ROUTINES ; 3/20/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;**8,19**;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; -- This routine displays unresolved domain in FFX file
6 ;
7DSPFF(SNIFN) ; -- List processor entry point
8 ;
9 ; This is the main entry point for calling the list manager
10 ;
11 ; Parameters:
12 ; SNIFN - The inistitution internal entry number
13 ;
14 N LSTARRAY,IDXARRAY,VALMCNT
15 ;
16 ;
17 K XQORS,VALMEVL
18 D EN^VALM("PPP UNRESOLVED DOM")
19 Q
20 ;
21INIT ; -- Collects all the data and builds the display array
22 ;
23 N PPPINST,CNT
24 ;
25 S LSTARRAY="^TMP(""PPPL4"",$J)"
26 S IDXARRAY="^TMP(""PPPIDX"",$J)"
27 ;
28 K @LSTARRAY,@IDXARRAY,DOMAIN
29 ;
30 S (VALMCNT,CNT)=0
31 I '$D(^PPP(1020.2,"ARPOV",+SNIFN)) D NUL Q
32 F PATDFN=0:0 D Q:(PATDFN="")
33 .S PATDFN=$O(^PPP(1020.2,"ARPOV",+SNIFN,PATDFN)) Q:PATDFN=""
34 .S PATNAME=$$GETPATNM^PPPGET1(PATDFN)
35 .S FFXIFN=$O(^PPP(1020.2,"ARPOV",+SNIFN,PATDFN,"")) Q:FFXIFN=""
36 .S DOMAIN=$P($G(^PPP(1020.2,FFXIFN,1)),"^",5)
37 .S DOMAIN=$S($G(DOMAIN)="":"Unknown",1:DOMAIN)
38 .S LNUM=0 I DOMAIN]"" S LNUM=$O(^PPP(1020.128,"A",DOMAIN,0))
39 .I LNUM S DOMAIN=$P(^PPP(1020.128,LNUM,0),"^",2) ;New Domain
40 .S PPPINST=$S($D(DOMAIN):$P(DOMAIN,".",1),1:$P($P($G(^PPP(1020.2,FFXIFN,0)),"^",2),".",1))
41 .D SETD
42 Q
43 ;
44HDR ; -- Builds Header
45 ;
46 N SP25
47 S SP25=" "
48 S VALMHDR(1)=""
49 S VALMHDR(2)="Institution: "_$E($P(SNIFN,"^",2)_SP25,1,25)_" Default Domain: "_$P($G(^PPP(1020.8,+SNIFN,0)),"^",2)
50 Q
51 ;
52NUL ; -- Sets null message
53 ;
54 S @LSTARRAY@(1,0)=""
55 S @LSTARRAY@(2,0)=" There are no entries for "_$P(SNIFN,"^",2)
56 S @LSTARRAY@(3,0)=""
57 S @LSTARRAY@(4,0)=" Press <RETURN> to continue"
58 S VALMCNT=4
59 Q
60FNL ; -- Clean up
61 ;
62 K @LSTARRAY,@IDXARRAY
63 K SNIFN
64 Q
65 ;
66SETD ; -- Sets up display for line for list processor
67 S TXTLINE=" "
68 S CNT=CNT+1
69 S TXTLINE=$$SETFLD^VALM1(" "_CNT,TXTLINE,"ENTRY")
70 S TXTLINE=$$SETFLD^VALM1(PATNAME,TXTLINE,"PATNAME")
71 S TXTLINE=$$SETFLD^VALM1(PPPINST,TXTLINE,"INSTITUTION")
72 S TXTLINE=$$SETFLD^VALM1(DOMAIN,TXTLINE,"DOMAIN")
73 D SETL
74 Q
75 ;
76SETL ; -- Sets up list manager display array
77 S VALMCNT=VALMCNT+1
78 S @LSTARRAY@(VALMCNT,0)=$E(TXTLINE,1,79)
79 S @LSTARRAY@("IDX",VALMCNT,CNT)=""
80 S @IDXARRAY@(CNT)=VALMCNT_"@"_SNIFN_"@"_FFXIFN_"@"_DOMAIN
81 Q
82 ;
83END ; -- End of code
84 Q
85 ;
Note: See TracBrowser for help on using the repository browser.