source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOHLDI1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 3.4 KB
Line 
1PSOHLDI1 ;BIR/PWC,SAB - Automated Dispense Completion HL7 v.2.4 cont. ;10/25/06 10:04am
2 ;;7.0;OUTPATIENT PHARMACY;**259,268**;DEC 1997;Build 9
3 ;Reference to ^PSD(58.8 supported by DBIA 1036
4 ;Reference to ^XTMP("PSA" supported by DBIA 1036
5 ;This routine is called by PSOHLDIS
6 ;
7 ;*259 create routine to hold DRGACCT, psohldis exceeded 10k, also
8 ; add MAIL tag for Email Alert to mail group.
9 ;
10 Q
11 ;
12BINGREL ;displays to bingo board
13 N NAM,NAME,RXO,SSN S ADA="",BRXP=RXID
14 F XX=0:0 S XX=$O(^PS(52.11,"B",BNAM,XX)) Q:'XX D
15 .F BRX=0:0 S BRX=$O(^PS(52.11,XX,2,"B",BRX)) Q:'BRX I BRX=BRXP S (DA,ODA)=XX
16 Q:'$D(DA)
17 I $P($G(^PS(52.11,DA,0)),"^",7)]"" Q
18 I $P($P($G(^PS(52.11,DA,0)),"^",5),".")'=DT S DIK="^PS(52.11," D ^DIK K DIK Q
19 N TM,TM1 D NOW^%DTC S TM=$E(%,1,12),TM1=$P(TM,".",2)
20 S NM=$P(^DPT($P(^PS(52.11,DA,0),"^"),0),"^"),DR="6////"_$E(TM1_"0000",1,4)_";8////"_NM_"",DIE="^PS(52.11,"
21 L +^PS(52.11,DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) E Q
22 D ^DIE L -^PS(52.11,DA) I $G(X)="" S DIK="^PS(52.11," D ^DIK K DIK Q
23 S RX0=^PS(52.11,DA,0),JOES=$P(RX0,"^",4),TICK=+$P($G(RX0),"^",2),GRP=$P($G(^PS(59.3,$P($G(^PS(52.11,DA,0)),"^",3),0)),"^",2)
24 I GRP="T",'$G(TICK) S DIK="^PS(52.11," D ^DIK K DIK
25 Q:'$G(DA)
26 S PSZ=0 I '$D(^PS(59.2,DT,0)) K DD,DIC,DO,DA S X=DT,DIC="^PS(59.2,",DIC(0)="",DINUM=X D FILE^DICN S PSZ=1 Q:Y'>0
27 I PSZ=1 S DA(1)=+Y,DIC=DIC_DA(1)_",1,",(DINUM,X)=JOES,DIC(0)="",DIC("P")=$P(^DD(59.2,1,0),"^",2) K DD,DO D FILE^DICN K DIC,DA Q:Y'>0
28 I PSZ=0 K DD,DIC,DO,DA S DA(1)=DT,(DINUM,X)=JOES,DIC="^PS(59.2,"_DT_",1,",DIC(0)="LZ" D FILE^DICN K DIC,DA,DO
29 S DA=ODA D STATS1^PSOBRPRT,WTIME^PSOBING1
30 Q
31 ;
32DRGACCT(RXP) ;update Drug Accountability Package ;PSO*209
33 S RXP=+$G(RXP) Q:'RXP
34 N PSA,DIC,DA,DR,X,Y,DIQ,PSODA,PSOSITE,QDRUG,QTY,JOB192
35 S (JOB192,PSODA)=0
36 ;check for Drug Acct background job
37 S X="PSA IV ALL LOCATIONS",DIC(0)="MZ",DIC=19.2 D ^DIC S JOB192=Y
38 I JOB192>0,$P($G(Y(0)),U,2)>DT D
39 . S PSODA=1
40 . S:'$P($G(^XTMP("PSA",0)),U,2) $P(^(0),U,2)=DT
41 I JOB192'>0 D ;check old way of scheduling
42 . S X="PSA IV ALL LOCATIONS",DIC(0)="MZ",DIC=19 D ^DIC
43 . K DIQ,PSA S DA=+Y,DIC=19,DIQ="PSA",DR=200,DIQ(0)="IN" D EN^DIQ1
44 . I $G(PSA(19,DA,200,"I"))>DT D
45 . . S PSODA=1
46 . . S:'$P($G(^XTMP("PSA",0)),U,2) $P(^(0),U,2)=DT
47 ;drug stocked in Drug Acct Location?
48 S PSOSITE=+$O(^PS(59,0))
49 S PSODA(1)=$S($D(^PSD(58.8,+$O(^PSD(58.8,"AOP",PSOSITE,0)),1,+$P(^PSRX(RXP,0),U,6))):1,1:0)
50 ;if appropriate update ^XTMP("PSA", for Drug Acct
51 S QTY=$P($G(^PSRX(RXP,0)),"^",7)
52 S QDRUG=+$P($G(^PSRX(RXP,0)),"^",6)
53 Q:'QDRUG
54 I $G(PSODA),$G(PSODA(1)),'$D(^PSRX("AR",$$NOW^XLFDT,RXP,0)) S ^XTMP("PSA",PSOSITE,QDRUG,DT)=$G(^XTMP("PSA",PSOSITE,QDRUG,DT))+QTY
55 Q
56 ;
57MAIL ;Send mail message
58 S:'$G(DUZ) DUZ=.5
59 N PSOTTEXT,PSOIEN,PSOKEYN,XMY,XMDUZ,XMSUB,XMTEXT
60 S XMY("G.PSO EXTERNAL DISPENSE ALERTS")=""
61 ;if no members in group, then send to PSXCMOPMGR key holders
62 S PSOIEN=$O(^XMB(3.8,"B","PSO EXTERNAL DISPENSE ALERTS",0))
63 I '$O(^XMB(3.8,PSOIEN,1,0)) D
64 . S PSOKEYN=0
65 . F S PSOKEYN=$O(^XUSEC("PSXCMOPMGR",PSOKEYN)) Q:'PSOKEYN D
66 . . S XMY(PSOKEYN)=""
67 S XMDUZ="PSO EXTERNAL DISPENSE"
68 S XMSUB="External Dispense - Rx Release Attempted"
69 S PSOTTEXT(1)="Patient: "_NAME_" SSN: "_PSSN
70 S PSOTTEXT(2)=" Rx #: "_PSORX_" Fill: "_FLLN
71 S PSOTTEXT(3)=" Drug: "_$P(GIVECOD,"~",2)
72 S PSOTTEXT(4)=""
73 S PSOTTEXT(5)=ATXT
74 S PSOTTEXT(6)=""
75 S:ACTN]"" PSOTTEXT(7)=ACTN
76 S XMTEXT="PSOTTEXT(" D ^XMD
77 Q
Note: See TracBrowser for help on using the repository browser.