[613] | 1 | PSULR0 ;BIR/PDW - PBM LABORATORY EXTRACT ;25 AUG 1998
|
---|
| 2 | ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
---|
| 3 | ;
|
---|
| 4 | EN ;EP Tasking Entry Point for generating LAB mail messages, Summaries, & Prints
|
---|
| 5 | ;
|
---|
| 6 | ; pull in fresh copy of variables
|
---|
| 7 | S PSUVARS="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,ZTIO,PSUSNDR,PSUOPTS"
|
---|
| 8 | F I=1:1:$L(PSUVARS,",") S @$P(PSUVARS,",",I)=$P(^XTMP("PSU_"_PSUJOB,1),U,I)
|
---|
| 9 | ; save off a copy of variables
|
---|
| 10 | ;S X="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,PSUSNDR,PSULRSUB,PSULRJOB,PSUJOB,PSUOPTN,PSURTN"
|
---|
| 11 | ;F I=1:1 S Y=$P(X,",",I) Q:Y="" I $D(@Y) S X(Y)=@Y
|
---|
| 12 | ;M ^XTMP(PSULRSUB,"SAVE")=X
|
---|
| 13 | K X
|
---|
| 14 | ;
|
---|
| 15 | ; process Lab entries put into ^XTMP(PSULRSUB,"EVENTS") by IV, UD, OP
|
---|
| 16 | ;
|
---|
| 17 | D EN^PSULR1
|
---|
| 18 | D EN^PSULR2 ; Gather patient test(s) 'CH' nodes and get test results
|
---|
| 19 | D EN^PSULR3 ; Generate Records for detailed message and source for summary
|
---|
| 20 | K PSUMSG
|
---|
| 21 | D EN^PSULR4(.PSUMSG) ; Generate Detailed Mail Message
|
---|
| 22 | S PSUSUB="PSU_"_PSUJOB
|
---|
| 23 | I $D(^XTMP(PSUSUB)),PSUMASF M ^XTMP(PSUSUB,"CONFIRM")=PSUMSG
|
---|
| 24 | I $D(^XTMP(PSUSUB)),PSUPBMG M ^XTMP(PSUSUB,"CONFIRM")=PSUMSG
|
---|
| 25 | D EN^PSULR5 ; Summaries
|
---|
| 26 | Q
|
---|
| 27 | ;
|
---|
| 28 | PRINT ;EP Tasking Entry Point for generating LAB printouts
|
---|
| 29 | D EN^PSULR6
|
---|
| 30 | Q
|
---|
| 31 | ;
|
---|
| 32 | EXIT ;EP EXIT
|
---|
| 33 | M Z=^XTMP(PSUARSUB,PSUARJOB,"SAVE")
|
---|
| 34 | K ^XTMP(PSUARJOB)
|
---|
| 35 | ; Kill PSU Variables
|
---|
| 36 | D VARKILL^PSUTL
|
---|
| 37 | ; Restore Important Variables
|
---|
| 38 | S Y="" F S Y=$O(Z(Y)) Q:Y="" S @Y=Z(Y)
|
---|
| 39 | K Z
|
---|
| 40 | Q
|
---|
| 41 | ;
|
---|
| 42 | LAB(PSUPK,PSUDIV,PSUORD,PSUDFN,PSUDRGNM,PSUDRCD) ;EP pass by value into lab extract
|
---|
| 43 | I PSUDRCD="" Q ; No Drug Class Code passed
|
---|
| 44 | ; PSUPK - Package "IV" "UD" "OP"
|
---|
| 45 | ; PSUDIV - DIVISION ( internal form )
|
---|
| 46 | ; PSUORD - ORDER NUMBER (IV - order # , UD - order # , OP - Prescription Number)
|
---|
| 47 | ; PSUDFN - Patient IEN
|
---|
| 48 | ; PSUDRGN - Drug Generic Name ["FREE TEXT"]
|
---|
| 49 | ; PSUDRCD - VA Drug Class Code
|
---|
| 50 | ;
|
---|
| 51 | ; Screen out test patients
|
---|
| 52 | Q:$$TESTPAT^PSUTL1(PSUDFN)
|
---|
| 53 | ;
|
---|
| 54 | N PSULRDA
|
---|
| 55 | ; set basics
|
---|
| 56 | I '$G(PSUJOB) S PSUJOB=$J
|
---|
| 57 | I '$G(PSULRSUB) S PSULRSUB="PSULR_"_PSUJOB
|
---|
| 58 | I '$G(PSULRJOB) S PSULRJOB=PSUJOB
|
---|
| 59 | I '$D(^XTMP(PSULRSUB,PSULRJOB)) D
|
---|
| 60 | . S X1=DT,X2=+0 D C^%DTC
|
---|
| 61 | . S ^XTMP(PSULRSUB,PSULRJOB)=DT_U_X_U_" PBM LAB EXTRACT"
|
---|
| 62 | ;
|
---|
| 63 | ; Setup XTMP for Lab
|
---|
| 64 | S X1=DT,X2=6 D C^%DTC
|
---|
| 65 | S ^XTMP(PSULRSUB,0)=X_U_DT_"^ PBM Extract - Laboratory Module"
|
---|
| 66 | ;
|
---|
| 67 | I '$D(^XTMP(PSULRSUB,"CODES")) D SETCODES
|
---|
| 68 | ;
|
---|
| 69 | ; test to see if one of the select drug class codes
|
---|
| 70 | I '$D(^XTMP(PSULRSUB,"CODES",PSUDRCD)) Q
|
---|
| 71 | ;
|
---|
| 72 | ; store event
|
---|
| 73 | S PSULRDA=$O(^XTMP(PSULRSUB,"EVENT",""),-1)+1
|
---|
| 74 | S ^XTMP(PSULRSUB,"EVENT",PSULRDA)=PSUPK_U_PSUDIV_U_PSUDFN_U_PSUORD_U_PSUDRGNM_U_PSUDRCD
|
---|
| 75 | Q
|
---|
| 76 | ;
|
---|
| 77 | SETCODES ;EP TO SETUP CODES
|
---|
| 78 | ; set basics
|
---|
| 79 | I '$G(PSUJOB) S PSUJOB=$J
|
---|
| 80 | I '$G(PSULRSUB) S PSULRSUB="PSULR_"_PSUJOB
|
---|
| 81 | I '$G(PSULRJOB) S PSULRJOB=PSUJOB
|
---|
| 82 | I '$D(^XTMP(PSULRSUB,PSULRJOB)) D
|
---|
| 83 | . S X1=DT,X2=+0 D C^%DTC
|
---|
| 84 | . S ^XTMP(PSULRSUB,PSULRJOB)=DT_U_X_U_" PBM LAB EXTRACT"
|
---|
| 85 | F X="AN500","CV200","CV350","CV800","GA301","HS502" S ^XTMP(PSULRSUB,"CODES",X)=""
|
---|
| 86 | Q
|
---|
| 87 | ;
|
---|
| 88 | CLEAR ;EP Clear PSULR out of XTMP
|
---|
| 89 | S X="PSULR"
|
---|
| 90 | F S X=$O(^XTMP(X)) Q:$E(X,1,5)'="PSULR" W !,X K ^XTMP(X)
|
---|
| 91 | Q
|
---|