| 1 | PPPPRT11 ;ALB/JFP - DISPLAY LOG FILE ENTRIES ; 3/20/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 |  ; -- This routine displays entries in the PPP Log file
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 | DSPLOG(IDATE) ; -- List processor entry point
 | 
|---|
| 8 |  ;
 | 
|---|
| 9 |  ; This is the main entry point for calling the list manager
 | 
|---|
| 10 |  ;
 | 
|---|
| 11 |  ; Parameters:
 | 
|---|
| 12 |  ;  IDATE - The the report will start displaying data from.
 | 
|---|
| 13 |  ;
 | 
|---|
| 14 |  N LSTARRAY,IDXARRAY,VALMCNT,STRTDTE
 | 
|---|
| 15 |  ;
 | 
|---|
| 16 |  ;
 | 
|---|
| 17 |  S STRTDTE=IDATE
 | 
|---|
| 18 |  S Y=STRTDTE D DD^%DT S BDATE=Y
 | 
|---|
| 19 |  S Y=DT D DD^%DT S EDATE=Y
 | 
|---|
| 20 |  ;
 | 
|---|
| 21 |  K XQORS,VALMEVL
 | 
|---|
| 22 |  D EN^VALM("PPP LOG DISPL")
 | 
|---|
| 23 |  Q
 | 
|---|
| 24 |  ;
 | 
|---|
| 25 | INIT ; -- Collects all the data and builds the display array
 | 
|---|
| 26 |  ;
 | 
|---|
| 27 |  N X,Y,CNT,LOGDFN,LOGND,RTN,MSG,ICODE,CODE,DATE
 | 
|---|
| 28 |  N IUSER,EUSER,USER,TXTLINE
 | 
|---|
| 29 |  ;
 | 
|---|
| 30 |  ;
 | 
|---|
| 31 |  S LSTARRAY="^TMP(""PPPL5"",$J)"
 | 
|---|
| 32 |  S IDXARRAY="^TMP(""PPPIDX"",$J)"
 | 
|---|
| 33 |  ;
 | 
|---|
| 34 |  K @LSTARRAY,@IDXARRAY
 | 
|---|
| 35 |  ;
 | 
|---|
| 36 |  S (VALMCNT,CNT)=0
 | 
|---|
| 37 |  W !!,"Building display...this may take a moment"
 | 
|---|
| 38 |  F  D  D:CNT=0 NUL Q:(IDATE="")
 | 
|---|
| 39 |  .S IDATE=$O(^PPP(1020.4,"C",IDATE)) Q:IDATE=""
 | 
|---|
| 40 |  .S LOGDFN=0
 | 
|---|
| 41 |  .F  D  Q:(LOGDFN="")
 | 
|---|
| 42 |  ..S LOGDFN=$O(^PPP(1020.4,"C",IDATE,LOGDFN)) Q:LOGDFN=""
 | 
|---|
| 43 |  ..S LOGND(0)=$G(^PPP(1020.4,LOGDFN,0))
 | 
|---|
| 44 |  ..S RTN=$G(^PPP(1020.4,LOGDFN,1))
 | 
|---|
| 45 |  ..S MSG=$G(^PPP(1020.4,LOGDFN,2))
 | 
|---|
| 46 |  ..S ICODE=$P(LOGND(0),"^",1),CODE=""
 | 
|---|
| 47 |  ..S:ICODE'="" CODE=$P($G(^PPP(1020.6,ICODE,0)),"^",2)
 | 
|---|
| 48 |  ..S Y=$P(LOGND(0),"^",3)
 | 
|---|
| 49 |  ..D DD^%DT S DATE=Y
 | 
|---|
| 50 |  ..S IUSER=$P(LOGND(0),"^",4),EUSER=""
 | 
|---|
| 51 |  ..S:IUSER'="" USER=$P($G(^VA(200,IUSER,0)),"^",1)
 | 
|---|
| 52 |  ..D SETD
 | 
|---|
| 53 |  Q
 | 
|---|
| 54 |  ;
 | 
|---|
| 55 | HDR ; -- Builds Header
 | 
|---|
| 56 |  S VALMHDR(1)=""
 | 
|---|
| 57 |  S VALMHDR(2)="Data extracted for "_BDATE_" to "_EDATE
 | 
|---|
| 58 |  Q
 | 
|---|
| 59 |  ;
 | 
|---|
| 60 | NUL ; -- Sets null message
 | 
|---|
| 61 |  ;
 | 
|---|
| 62 |  S @LSTARRAY@(1,0)=""
 | 
|---|
| 63 |  S @LSTARRAY@(2,0)=" No entries found for "_BDATE_" to "_EDATE
 | 
|---|
| 64 |  S @LSTARRAY@(3,0)=""
 | 
|---|
| 65 |  S @LSTARRAY@(4,0)=" Press <RETURN> to continue"
 | 
|---|
| 66 |  S VALMCNT=4
 | 
|---|
| 67 |  Q
 | 
|---|
| 68 | FNL ; -- Clean up
 | 
|---|
| 69 |  ;
 | 
|---|
| 70 |  K @LSTARRAY,@IDXARRAY
 | 
|---|
| 71 |  K IDATE,BDATE,EDATE
 | 
|---|
| 72 |  Q
 | 
|---|
| 73 |  ;
 | 
|---|
| 74 | SETD ; -- Sets up display for line for list processor
 | 
|---|
| 75 |  S TXTLINE=" "
 | 
|---|
| 76 |  S CNT=CNT+1
 | 
|---|
| 77 |  S TXTLINE=$$SETFLD^VALM1(""_DATE,TXTLINE,"DATE")
 | 
|---|
| 78 |  S TXTLINE=$$SETFLD^VALM1(USER,TXTLINE,"USER")
 | 
|---|
| 79 |  S TXTLINE=$$SETFLD^VALM1(RTN,TXTLINE,"ROUTINE")
 | 
|---|
| 80 |  D SETL
 | 
|---|
| 81 |  S TXTLINE=$$SETSTR^VALM1(CODE_"  "_MSG,"",1,79)
 | 
|---|
| 82 |  D SETL
 | 
|---|
| 83 |  S TXTLINE=$$SETSTR^VALM1(" ","",1,79)
 | 
|---|
| 84 |  D SETL
 | 
|---|
| 85 |  Q
 | 
|---|
| 86 |  ;
 | 
|---|
| 87 | SETL ; -- Sets up list manager display array
 | 
|---|
| 88 |  S VALMCNT=VALMCNT+1
 | 
|---|
| 89 |  S @LSTARRAY@(VALMCNT,0)=$E(TXTLINE,1,79)
 | 
|---|
| 90 |  S @LSTARRAY@("IDX",VALMCNT,CNT)=""
 | 
|---|
| 91 |  S @IDXARRAY@(CNT)=VALMCNT
 | 
|---|
| 92 |  Q
 | 
|---|
| 93 |  ;
 | 
|---|
| 94 | END ; -- End of code
 | 
|---|
| 95 |  Q
 | 
|---|
| 96 |  ;
 | 
|---|