Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOERXR1

PSOERXR1.m

Go to the documentation of this file.
  1. PSOERXR1 ;ALB/BWF - eRx Provider Validation - ListMan ; 8/3/2016 5:14pm
  1. ;;7.0;OUTPATIENT PHARMACY;**467,520,527,581,545,700,746**;DEC 1997;Build 106
  1. ;
  1. EN ; -- main entry point for PSO ERX HOLDING QUEUE
  1. D EN^VALM("PSO ERX PROVIDER VALIDATION")
  1. Q
  1. ;
  1. LMHDR ; ListMan Header Code
  1. D SHOW^VALM,HDR^PSOERXR1
  1. S XQORM("??")="D HELP^VALM2,HDR^PSOERXR1"
  1. Q
  1. ;
  1. HDR ; -- header code
  1. N AMATCH,VPROIEN,VALUSER,VALDTTM,MATCH,HDR
  1. S AMATCH=$$GET1^DIQ(52.49,PSOIEN,1.2,"I"),VPROIEN=$$GET1^DIQ(52.49,PSOIEN,2.3,"I")
  1. S VALUSER=$$GET1^DIQ(52.49,PSOIEN,1.8,"E"),VALDTTM=$$GET1^DIQ(52.49,PSOIEN,1.9,"I")
  1. S VALMHDR(1)="eRx Reference #: "_IOINHI_$$GET1^DIQ(52.49,PSOIEN,.01,"E")_IOINORM
  1. D INSTR^VALM1("eRx Patient: "_IOINHI_$$GET1^DIQ(52.49,PSOIEN,.04,"E")_IOINORM,32,2)
  1. S MATCH=$S(AMATCH=1:"AUTO-MATCHED",AMATCH=2:"AUTO-MATCHED/EDITED",VPROIEN:"MANUALLY-MATCHED",1:"")
  1. I VALUSER'="",MATCH'="" S MATCH=MATCH_" | VALIDATED by "_$E(VALUSER,1,19)_" on "_$$FMTE^XLFDT(VALDTTM,"2Y")
  1. I MATCH="" S MATCH="NOT MATCHED"
  1. S $E(MATCH,81)="" D INSTR^VALM1("Status: "_IOINHI_MATCH_IOINORM,1,3)
  1. S HDR="",$E(HDR,15)="ERX PROVIDER",$E(HDR,40)="|",$E(HDR,54)="VISTA PROVIDER"
  1. S $E(HDR,81)="" D INSTR^VALM1(IORVON_IOUON_HDR_IORVOFF_IOINORM,1,4)
  1. Q
  1. ;
  1. INIT ;
  1. Q:'$G(PSOIEN) K ^XTMP("PSOERXR1",$J)
  1. ; - Resetting list to NORMAL video attributes
  1. D RESET^PSOERUT0()
  1. S LINE=1
  1. ;
  1. D SETPROV^PSOERUT1("LM",PSOIEN,,"PSOERXR1")
  1. ;
  1. S VALMCNT=LINE-1
  1. S EDTYP="PR"
  1. ; - Saving NORMAL video attributes to be reset later
  1. I LINE>$G(LASTLINE) D
  1. . F I=($G(LASTLINE)+1):1:LINE D SAVE^VALM10(I)
  1. . S LASTLINE=LINE
  1. D VIDEO^PSOERUT0()
  1. Q
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. K EDTYP,@VALMAR
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q