86 lines
2.3 KiB
Mathematica
86 lines
2.3 KiB
Mathematica
PPPEDT21 ;ALB/JFP - EDIT BLANK DOMAIN ROUTINES ; 3/20/92
|
|
;;V1.0;PHARMACY PRESCRIPTION PRACTICE;**8,19**;APR 7,1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
; -- This routine displays unresolved domain in FFX file
|
|
;
|
|
DSPFF(SNIFN) ; -- List processor entry point
|
|
;
|
|
; This is the main entry point for calling the list manager
|
|
;
|
|
; Parameters:
|
|
; SNIFN - The inistitution internal entry number
|
|
;
|
|
N LSTARRAY,IDXARRAY,VALMCNT
|
|
;
|
|
;
|
|
K XQORS,VALMEVL
|
|
D EN^VALM("PPP UNRESOLVED DOM")
|
|
Q
|
|
;
|
|
INIT ; -- Collects all the data and builds the display array
|
|
;
|
|
N PPPINST,CNT
|
|
;
|
|
S LSTARRAY="^TMP(""PPPL4"",$J)"
|
|
S IDXARRAY="^TMP(""PPPIDX"",$J)"
|
|
;
|
|
K @LSTARRAY,@IDXARRAY,DOMAIN
|
|
;
|
|
S (VALMCNT,CNT)=0
|
|
I '$D(^PPP(1020.2,"ARPOV",+SNIFN)) D NUL Q
|
|
F PATDFN=0:0 D Q:(PATDFN="")
|
|
.S PATDFN=$O(^PPP(1020.2,"ARPOV",+SNIFN,PATDFN)) Q:PATDFN=""
|
|
.S PATNAME=$$GETPATNM^PPPGET1(PATDFN)
|
|
.S FFXIFN=$O(^PPP(1020.2,"ARPOV",+SNIFN,PATDFN,"")) Q:FFXIFN=""
|
|
.S DOMAIN=$P($G(^PPP(1020.2,FFXIFN,1)),"^",5)
|
|
.S DOMAIN=$S($G(DOMAIN)="":"Unknown",1:DOMAIN)
|
|
.S LNUM=0 I DOMAIN]"" S LNUM=$O(^PPP(1020.128,"A",DOMAIN,0))
|
|
.I LNUM S DOMAIN=$P(^PPP(1020.128,LNUM,0),"^",2) ;New Domain
|
|
.S PPPINST=$S($D(DOMAIN):$P(DOMAIN,".",1),1:$P($P($G(^PPP(1020.2,FFXIFN,0)),"^",2),".",1))
|
|
.D SETD
|
|
Q
|
|
;
|
|
HDR ; -- Builds Header
|
|
;
|
|
N SP25
|
|
S SP25=" "
|
|
S VALMHDR(1)=""
|
|
S VALMHDR(2)="Institution: "_$E($P(SNIFN,"^",2)_SP25,1,25)_" Default Domain: "_$P($G(^PPP(1020.8,+SNIFN,0)),"^",2)
|
|
Q
|
|
;
|
|
NUL ; -- Sets null message
|
|
;
|
|
S @LSTARRAY@(1,0)=""
|
|
S @LSTARRAY@(2,0)=" There are no entries for "_$P(SNIFN,"^",2)
|
|
S @LSTARRAY@(3,0)=""
|
|
S @LSTARRAY@(4,0)=" Press <RETURN> to continue"
|
|
S VALMCNT=4
|
|
Q
|
|
FNL ; -- Clean up
|
|
;
|
|
K @LSTARRAY,@IDXARRAY
|
|
K SNIFN
|
|
Q
|
|
;
|
|
SETD ; -- Sets up display for line for list processor
|
|
S TXTLINE=" "
|
|
S CNT=CNT+1
|
|
S TXTLINE=$$SETFLD^VALM1(" "_CNT,TXTLINE,"ENTRY")
|
|
S TXTLINE=$$SETFLD^VALM1(PATNAME,TXTLINE,"PATNAME")
|
|
S TXTLINE=$$SETFLD^VALM1(PPPINST,TXTLINE,"INSTITUTION")
|
|
S TXTLINE=$$SETFLD^VALM1(DOMAIN,TXTLINE,"DOMAIN")
|
|
D SETL
|
|
Q
|
|
;
|
|
SETL ; -- Sets up list manager display array
|
|
S VALMCNT=VALMCNT+1
|
|
S @LSTARRAY@(VALMCNT,0)=$E(TXTLINE,1,79)
|
|
S @LSTARRAY@("IDX",VALMCNT,CNT)=""
|
|
S @IDXARRAY@(CNT)=VALMCNT_"@"_SNIFN_"@"_FFXIFN_"@"_DOMAIN
|
|
Q
|
|
;
|
|
END ; -- End of code
|
|
Q
|
|
;
|