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

PSULR0.m

Go to the documentation of this file.
  1. PSULR0 ;BIR/PDW - PBM LABORATORY EXTRACT ;25 AUG 1998
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1. ;
  1. EN ;EP Tasking Entry Point for generating LAB mail messages, Summaries, & Prints
  1. ;
  1. ; pull in fresh copy of variables
  1. S PSUVARS="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,ZTIO,PSUSNDR,PSUOPTS"
  1. F I=1:1:$L(PSUVARS,",") S @$P(PSUVARS,",",I)=$P(^XTMP("PSU_"_PSUJOB,1),U,I)
  1. ; save off a copy of variables
  1. ;S X="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,PSUSNDR,PSULRSUB,PSULRJOB,PSUJOB,PSUOPTN,PSURTN"
  1. ;F I=1:1 S Y=$P(X,",",I) Q:Y="" I $D(@Y) S X(Y)=@Y
  1. ;M ^XTMP(PSULRSUB,"SAVE")=X
  1. K X
  1. ;
  1. ; process Lab entries put into ^XTMP(PSULRSUB,"EVENTS") by IV, UD, OP
  1. ;
  1. D EN^PSULR1
  1. D EN^PSULR2 ; Gather patient test(s) 'CH' nodes and get test results
  1. D EN^PSULR3 ; Generate Records for detailed message and source for summary
  1. K PSUMSG
  1. D EN^PSULR4(.PSUMSG) ; Generate Detailed Mail Message
  1. S PSUSUB="PSU_"_PSUJOB
  1. I $D(^XTMP(PSUSUB)),PSUMASF M ^XTMP(PSUSUB,"CONFIRM")=PSUMSG
  1. I $D(^XTMP(PSUSUB)),PSUPBMG M ^XTMP(PSUSUB,"CONFIRM")=PSUMSG
  1. D EN^PSULR5 ; Summaries
  1. Q
  1. ;
  1. PRINT ;EP Tasking Entry Point for generating LAB printouts
  1. D EN^PSULR6
  1. Q
  1. ;
  1. EXIT ;EP EXIT
  1. M Z=^XTMP(PSUARSUB,PSUARJOB,"SAVE")
  1. K ^XTMP(PSUARJOB)
  1. ; Kill PSU Variables
  1. D VARKILL^PSUTL
  1. ; Restore Important Variables
  1. S Y="" F S Y=$O(Z(Y)) Q:Y="" S @Y=Z(Y)
  1. K Z
  1. Q
  1. ;
  1. LAB(PSUPK,PSUDIV,PSUORD,PSUDFN,PSUDRGNM,PSUDRCD) ;EP pass by value into lab extract
  1. I PSUDRCD="" Q ; No Drug Class Code passed
  1. ; PSUPK - Package "IV" "UD" "OP"
  1. ; PSUDIV - DIVISION ( internal form )
  1. ; PSUORD - ORDER NUMBER (IV - order # , UD - order # , OP - Prescription Number)
  1. ; PSUDFN - Patient IEN
  1. ; PSUDRGN - Drug Generic Name ["FREE TEXT"]
  1. ; PSUDRCD - VA Drug Class Code
  1. ;
  1. ; Screen out test patients
  1. Q:$$TESTPAT^PSUTL1(PSUDFN)
  1. ;
  1. N PSULRDA
  1. ; set basics
  1. I '$G(PSUJOB) S PSUJOB=$J
  1. I '$G(PSULRSUB) S PSULRSUB="PSULR_"_PSUJOB
  1. I '$G(PSULRJOB) S PSULRJOB=PSUJOB
  1. I '$D(^XTMP(PSULRSUB,PSULRJOB)) D
  1. . S X1=DT,X2=+0 D C^%DTC
  1. . S ^XTMP(PSULRSUB,PSULRJOB)=DT_U_X_U_" PBM LAB EXTRACT"
  1. ;
  1. ; Setup XTMP for Lab
  1. S X1=DT,X2=6 D C^%DTC
  1. S ^XTMP(PSULRSUB,0)=X_U_DT_"^ PBM Extract - Laboratory Module"
  1. ;
  1. I '$D(^XTMP(PSULRSUB,"CODES")) D SETCODES
  1. ;
  1. ; test to see if one of the select drug class codes
  1. I '$D(^XTMP(PSULRSUB,"CODES",PSUDRCD)) Q
  1. ;
  1. ; store event
  1. S PSULRDA=$O(^XTMP(PSULRSUB,"EVENT",""),-1)+1
  1. S ^XTMP(PSULRSUB,"EVENT",PSULRDA)=PSUPK_U_PSUDIV_U_PSUDFN_U_PSUORD_U_PSUDRGNM_U_PSUDRCD
  1. Q
  1. ;
  1. SETCODES ;EP TO SETUP CODES
  1. ; set basics
  1. I '$G(PSUJOB) S PSUJOB=$J
  1. I '$G(PSULRSUB) S PSULRSUB="PSULR_"_PSUJOB
  1. I '$G(PSULRJOB) S PSULRJOB=PSUJOB
  1. I '$D(^XTMP(PSULRSUB,PSULRJOB)) D
  1. . S X1=DT,X2=+0 D C^%DTC
  1. . S ^XTMP(PSULRSUB,PSULRJOB)=DT_U_X_U_" PBM LAB EXTRACT"
  1. F X="AN500","CV200","CV350","CV800","GA301","HS502" S ^XTMP(PSULRSUB,"CODES",X)=""
  1. Q
  1. ;
  1. CLEAR ;EP Clear PSULR out of XTMP
  1. S X="PSULR"
  1. F S X=$O(^XTMP(X)) Q:$E(X,1,5)'="PSULR" W !,X K ^XTMP(X)
  1. Q