source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSO160P2.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.0 KB
Line 
1PSO160P2 ;BIR/MR-Patch 160 Post Install routine - Part 2 ;11/27/03
2 ;;7.0;OUTPATIENT PHARMACY;**160**;DEC 1997
3 ;External reference ^SCE( supported by DBIA 402
4 ;
5EN N DAT,ENC,TODAY,INACT,DIE,DA,DR,CLI,SORT
6 ;
7 ; - Patient is already TPB Inactive (INACTIVATION OF BENEFIT DATE)
8 I PSOTIBD'="" Q
9 ;
10 ; - At least one active TPB prescription found, if NOT Quit
11 I $$ACTRX^PSOTPCUL(PSOTDFN,1) Q
12 ;
13 S DAT=PSOTDBG-1,(ENC,INACT)=0 D NOW^%DTC S TODAY=%\1
14 F S DAT=$O(^SCE("ADFN",PSOTDFN,DAT)) Q:'DAT D I INACT Q
15 . F S ENC=$O(^SCE("ADFN",PSOTDFN,DAT,ENC)) Q:'ENC D I INACT Q
16 . . ;
17 . . ; - NOT an Appointment
18 . . I $$GET1^DIQ(409.68,ENC,.08,"I")'=1 Q
19 . . ;
20 . . ; - Appointment is not CHECKED OUT
21 . . I $$UP^XLFSTR($TR($$GET1^DIQ(409.68,ENC,.12),"- "))'="CHECKEDOUT" Q
22 . . ;
23 . . ; - STOP CODE for the Encounter Location not TPB
24 . . I '$$TPBSC^PSOTPCUL($$GET1^DIQ(409.68,ENC,.04,"I")) Q
25 . . ;
26 . . ; - Inactivate TPB benefits for the patient
27 . . S DIE=52.91,DA=PSOTDFN,DR="2///"_TODAY_";3///1" D ^DIE K DIE,DR,DA
28 . . ;
29 . . ; - Set ^XTMP("PSO160P2",$J) for the Mailman Message
30 . . S CLI=$$GET1^DIQ(409.68,ENC,.04)
31 . . ;
32 . . ; - Sets ^TMP global for Mailman Message
33 . . S SORT=$E(PATNAM,1,23)_"("_PATSSN_")"
34 . . S ^XTMP("PSO160P2",$J,"T",SORT)=DAT_"^"_CLI
35 . . S INACT=1
36 ;
37 Q
38 ;
39MAIL ; Sends Mailman message to PSO TPB GROUP mail group with list of
40 ; patients that have been inactivated.
41 N DFN,XMTEXT,XMDUZ,XMSUB,DASH,LINE,HDR,XMY,CNT,DASH,DATA,DIFROM,TEXT
42 N PNAM
43 ;
44 S XMDUZ="PATCH PSO*7*160" D SXMY^PSOTPCUL("PSO TPB GROUP")
45 S XMY(DUZ)="",XMSUB="PSO*7*160 - LIST OF TPB PATIENTS INACTIVATED"
46 ;
47 ; Mailman Message - Header
48 S $P(DASH,"-",79)="",LINE=0
49 D SETLN("The Post-Install process for PSO*7*160 - Part 2 successfully completed.")
50 D SETLN(" ")
51 D SETLN("Started on: "_$$FMTE^XLFDT($G(^XTMP("PSO160DR",$J,"START"))))
52 D SETLN("Finished on: "_$$FMTE^XLFDT($G(^XTMP("PSO160DR",$J,"FINISH"))))
53 D SETLN(" ")
54 ;
55 ;If no entries created above, skip reporting
56 I '$D(^XTMP("PSO160P2",$J,"T")) D G SEND
57 . D SETLN("No patients have been inactivated from TPB (Transitional Pharmacy Benefit).")
58 ;
59 D SETLN("The following patients had their TPB (Transitional Pharmacy Benefit) benefit")
60 D SETLN("automatically inactivated because the following appointment was found: ")
61 D SETLN(" "),SETLN(DASH)
62 S HDR="PATIENT (LAST4SSN)",$E(HDR,31)="APPOINTMENT DATE"
63 S $E(HDR,50)="VA CLINIC" D SETLN(HDR),SETLN(DASH)
64 ;
65 ; Mailman Message - Body
66 S PNAM="",CNT=0
67 F S PNAM=$O(^XTMP("PSO160P2",$J,"T",PNAM)) Q:PNAM="" D
68 . S DATA=$G(^XTMP("PSO160P2",$J,"T",PNAM))
69 . S TEXT=PNAM,$E(TEXT,31)=$$FMTE^XLFDT($P(DATA,"^"))
70 . S $E(TEXT,50)=$E($P(DATA,"^",2),1,30)
71 . D SETLN(TEXT) S CNT=CNT+1
72 ;
73 ; Mailman Messae - Footer
74 D SETLN(" "),SETLN("Total: "_CNT_" Patient(s)")
75 ;
76SEND ; - Calls ^XMD to send the message
77 S XMTEXT="^XTMP(""PSO160P2"",$J,""M""," D ^XMD
78 K ^XTMP("PSO160P2",$J,"M")
79 Q
80 ;
81SETLN(TXT) ; Sets a line in the XTMP global for the Mailman Message
82 S LINE=$G(LINE)+1
83 S ^XTMP("PSO160P2",$J,"M",LINE)=TXT
84 Q
Note: See TracBrowser for help on using the repository browser.