| [613] | 1 | PPPEDT21 ;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 | ;
|
|---|
| 7 | DSPFF(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 | ;
|
|---|
| 21 | INIT ; -- 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 | ;
|
|---|
| 44 | HDR ; -- 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 | ;
|
|---|
| 52 | NUL ; -- 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
|
|---|
| 60 | FNL ; -- Clean up
|
|---|
| 61 | ;
|
|---|
| 62 | K @LSTARRAY,@IDXARRAY
|
|---|
| 63 | K SNIFN
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | SETD ; -- 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 | ;
|
|---|
| 76 | SETL ; -- 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 | ;
|
|---|
| 83 | END ; -- End of code
|
|---|
| 84 | Q
|
|---|
| 85 | ;
|
|---|
