Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOORUTL.m

    r613 r623  
    1 PSOORUTL        ;ISC BHAM/SAB  - updates order status from oerr ;6/28/07 7:36am
    2         ;;7.0;OUTPATIENT PHARMACY;**14,46,146,132,118,199,223,148,249,274,225**;DEC 1997;Build 29
    3         ;External reference to EN^ORERR - 2187
    4         ;External reference to ^PS(55 - 2228
    5         ;Input variables, poerr("psofilnm")=pharmacy pointer # from OE/RR, poerr("stat")=Order Control status
    6         ;poerr("pharmst")=will contain 'ZE'if rx has expired, poerr("comm")=Comments, poerr("user")=Person placing request
    7 EN(POERR)       ;
    8         N PSZORS,III
    9         F OO=0:0 S OO=$O(MSG(OO)) Q:'OO  I $P(MSG(OO),"|")="ZRN" S NVA=1
    10         I $G(NVA) G NVA
    11         G:POERR("PSOFILNM")'["S" RXO S III=+POERR("PSOFILNM")
    12         S ORS=0 I $D(^PS(52.41,III,0)) D  G PEXIT
    13         .Q:$P($G(^PS(52.41,III,0)),"^",3)="RF"
    14         .I $G(PDFN),$P($G(^PS(52.41,III,0)),"^",2),PDFN'=$P(^PS(52.41,III,0),"^",2) S ORS=1
    15 RXO     S III=POERR("PSOFILNM") I $D(^PSRX(III,0)) D  G PEXIT
    16         .I $G(PDFN),$P($G(^PSRX(III,0)),"^",2),PDFN'=$P(^PSRX(III,0),"^",2) S ORS=1
    17         S (ORS,PSZORS)=1
    18 PEXIT   I $G(ORS) S POERR("STAT")=$S(POERR("STAT")="CA":"UC",POERR("STAT")="DC":"UD",POERR("STAT")="HD":"UH",1:"UR"),POERR("FILLER")="",POERR("COMM")=$S($G(PSZORS):"Invalid Pharmacy order number",1:"Patient does not match.") K ORS,PSZORS,III Q
    19         S POERR("PHARMST")="" G:POERR("STAT")="HD"!(POERR("STAT")="RL") HD
    20         S ORS=0 I POERR("PSOFILNM")["S" S DA=+POERR("PSOFILNM") I $D(^PS(52.41,DA,0)) D  G EXIT
    21         .Q:$P($G(^PS(52.41,DA,0)),"^",3)="RF"
    22         .S $P(^PS(52.41,DA,0),"^",3)="DC",POERR("PLACE")=$P(^(0),"^"),POERR("STAT")="CR",POERR("FILLER")=DA_"^P"
    23         .K ^PS(52.41,"AOR",+$P($G(^PS(52.41,DA,0)),"^",2),+$P($G(^PS(52.41,DA,"INI")),"^"),DA)
    24         .S:$G(POERR("COMM"))']"" POERR("COMM")="Order Canceled by OE/RR before finishing." S ORS=1,$P(^PS(52.41,DA,4),"^")=$G(POERR("COMM"))
    25         S DA=POERR("PSOFILNM") D:$D(^PSRX(DA,0)) REVERSE^PSOBPSU1(DA,,"DC",7)
    26         I $D(^PSRX(DA,0)) D  S $P(^PSRX(DA,"STA"),"^")=14,$P(^PSRX(DA,3),"^",5)=DT,$P(^PSRX(DA,3),"^",10)=$P(^PSRX(DA,3),"^") D CAN^PSOTPCAN(DA) G EXIT
    27         .;cancel/discontinue action
    28         .S POERR("PLACE")=+$P($G(^PSRX(DA,"OR1")),"^",2),POERR("STAT")=$S(POERR("STAT")="CA":"CR",1:"DR"),POERR("FILLER")=DA_"^R"
    29         .S:'$D(POERR("COMM")) POERR("COMM")="Prescription DISCONTINUED by OERR"
    30         .S ORS=1 D CAN
    31 EXIT    I '$G(ORS) D
    32         .S POERR("STAT")=$S(POERR("STAT")="CA":"UC",POERR("STAT")="DC":"UD",POERR("STAT")="HD":"UH",1:"UR"),POERR("FILLER")="",POERR("COMM")="Order was not located by Pharmacy"
    33         K EXP,ORS,DA,ACOM,RXDA,SUSD,PSUS,RXF,I,FDA,DIC,DIE,DR,Y,X,%,%I,%H,RSDT,ACNT,ACT,DIK,FDT,IR,LFD,NOW,ORD,PSDA,PSCDA,PSODFN,PSUS,RF,RFCNT,RXN,RXP,RXREF,SD,SUB
    34         Q
    35 CAN     S ACOM="Discontinued by OE/RR." I $P(^PSRX(DA,"STA"),"^")=3!($P(^("STA"),"^")=16) D
    36         .S ACOM="Discontinued by OE/RR while on hold. " K:$P(^PSRX(DA,"H"),"^") ^PSRX("AH",$P(^PSRX(DA,"H"),"^"),DA) S ^PSRX(DA,"H")=""
    37         .I $P(^PSRX(DA,0),"^",13),'$O(^PSRX(DA,1,0)) S DIE=52,DR="22///"_$E($P(^PSRX(DA,0),"^",13),1,7) D ^DIE K DIE,DR Q
    38         .S (IFN,SUSD)=0 F  S IFN=$O(^PSRX(DA,1,IFN)) Q:'IFN  S SUSD=IFN,RFDT=$P(^PSRX(DA,1,IFN,0),"^")
    39         .Q:'$G(SUSD)  I '$P(^PSRX(DA,1,SUSD,0),"^",18) S PSDTEST=0 D  I 'PSDTEST K ^PSRX(DA,1,SUSD),^PSRX("AD",RFDT,DA,SUSD),^PSRX(DA,1,"B",RFDT,SUSD),IFN,SUSD,RFDT
    40         ..F PDA=0:0 S PDA=$O(^PSRX(DA,"L",PDA)) Q:'PDA  I $P($G(^PSRX(DA,"L",PDA,0)),"^",2)=SUSD S PSDTEST=1
    41         ..K CMOP D ^PSOCMOPA I $G(CMOP(CMOP("L")))="",$G(CMOP("S"))'="L" Q
    42         ..S PSDTEST=1
    43         S RXDA=DA,(DA,SUSDA)=$O(^PS(52.5,"B",DA,0)) D:DA
    44         .S SUSD=$P($G(^PS(52.5,DA,0)),"^",2)
    45         .S:+$G(^PS(52.5,DA,"P"))'=1 ACOM="Discontinued by OE/RR while suspended."
    46         .I $O(^PSRX(RXDA,1,0)) S DA=RXDA D:'$G(^PS(52.5,+SUSDA,"P")) REF^PSOCAN2
    47         .S DA=SUSDA,DIK="^PS(52.5," D ^DIK K DIK
    48         K SUSD,SUSDA S DA=RXDA,RXREF=0,PSODFN=+$P(^PSRX(DA,0),"^",2) D
    49         .S ACNT=0 F SUB=0:0 S SUB=$O(^PSRX(DA,"A",SUB)) Q:'SUB  S ACNT=SUB
    50         .S RFCNT=0 F RF=0:0 S RF=$O(^PSRX(DA,1,RF)) Q:'RF  S RFCNT=RF S:RF>5 RFCNT=RF+1
    51         .D NOW^%DTC S ^PSRX(DA,"A",0)="^52.3DA^"_(ACNT+1)_"^"_(ACNT+1),^PSRX(DA,"A",ACNT+1,0)=%_"^C^"_POERR("USER")_"^"_RFCNT_"^"_$G(ACOM)
    52         .S REA="C" D EXP^PSOHELP1
    53         I $G(^PS(52.4,DA,0))]"" S PSCDA=DA,DIK="^PS(52.4," D ^DIK S DA=PSCDA K DIK,PSCDA
    54         Q
    55 HD      ;place order on hold
    56         G:POERR("STAT")="RL" REL^PSOORUT1 S (ACT,ORS)=0 I POERR("PSOFILNM")["S" D  G EXIT
    57         .S DA=+POERR("PSOFILNM")
    58         .Q:'$D(^PS(52.41,DA,0))  Q:$P(^PS(52.41,DA,0),"^",3)="RF"
    59         .S $P(^PS(52.41,DA,0),"^",3)="HD",POERR("STAT")="HR",POERR("FILLER")=DA_"^P"
    60         .S:$G(POERR("COMM"))']"" POERR("COMM")="Order PLACED on HOLD by OERR before finished." S $P(^PS(52.41,DA,4),"^")=POERR("COMM"),ORS=1
    61         S DA=POERR("PSOFILNM") I $D(^PSRX(DA,0)) S ORS=1,PSDA=DA D  G EXIT
    62         .S POERR("FILLER")=DA_"^R"
    63         .S:'$D(POERR("COMM")) POERR("COMM")="Prescription Placed on HOLD by OERR"
    64         .I DT>$P(^PSRX(DA,2),"^",6) S EXP=$P(^(2),"^",6) S:$P(^PSRX(DA,"STA"),"^")<12 $P(^PSRX(DA,"STA"),"^")=11,PSOEXFLG=1 S POERR("STAT")="UH",POERR("COMM")="Prescription EXPIRED on "_$E(EXP,4,5)_"/"_$E(EXP,6,7)_"/"_$E(EXP,2,3)_"." D  Q
    65         ..D ECAN^PSOUTL(DA)
    66         .I $P(^PSRX(DA,"STA"),"^")=3!($P(^("STA"),"^")>11) S POERR("STAT")="UH",POERR("COMM")="Unable to place on HOLD" Q
    67         .S $P(^PSRX(DA,"STA"),"^")=16,POERR("STAT")="HR",^PSRX(DA,"H")=99_"^"_POERR("COMM")_"^"_DT
    68         .S (PSUS,RXF)=0 F I=0:0 S I=$O(^PSRX(DA,1,I)) Q:'I  S RXF=I S:RXF>1 RSDT=$P(^(RXF-1,0),"^")
    69         .S DA=PSDA D ACT D REVERSE^PSOBPSU1(DA,,"HLD",2)
    70         .S DA=$O(^PS(52.5,"B",PSDA,0)) I DA S DIK="^PS(52.5,",PSUS=1 D ^DIK K DA,DIK
    71         I 'ORS S POERR("COMM")="Unable to place order on HOLD" G EXIT
    72         Q
    73 NVA     ;non-va med action
    74         N DIE,DR,DA K NVA
    75         I POERR("PSOFILNM")'["N"!('$D(^PS(55,PDFN,"NVA",+POERR("PSOFILNM"),0))) D EN^ORERR("Order was not located by Pharmacy",.MSG) Q
    76         I $G(OR("STAT"))'="CA",$G(OR("STAT"))'="DC" D EN^ORERR("Invalid Order Control Code",.MSG) Q
    77 XO      S ORD=+POERR("PSOFILNM")
    78         N TMP
    79         D NOW^%DTC
    80         K TMP S TMP(55.05,ORD_","_PDFN_",",5)=$S($G(PSODEATH):2,1:1)
    81         S TMP(55.05,ORD_","_PDFN_",",6)=%
    82         D FILE^DIE("","TMP")
    83         S PLACER=$P(^PS(55,PDFN,"NVA",ORD,0),"^",8)
    84         K MSG S NULLFLDS="F JJ=0:1:LIMIT S FIELD(JJ)="""""
    85         K ^UTILITY("DIQ1",$J),DIQ S DA=$P($$SITE^VASITE(),"^")
    86         I $G(DA) S DIC=4,DIQ(0)="I",DR="99" D EN^DIQ1 S PSOHINST=$G(^UTILITY("DIQ1",$J,4,DA,99,"I")) K ^UTILITY("DIQ1",$J),DA,DR,DIQ,DIC
    87         S MSG(1)="MSH|^~\&|PHARMACY|"_$G(PSOHINST)_"|||||ORR"
    88         ;
    89         S DFN=PDFN,COUNT=1,LIMIT=5 X NULLFLDS D DEM^VADPT S NAME=$G(VADM(1)) K VADM
    90         S FIELD(0)="PID",FIELD(3)=DFN,FIELD(5)=NAME
    91         D SEG^PSOHLSN1
    92         ;
    93         S LIMIT=15 X NULLFLDS
    94         S FIELD(0)="ORC",FIELD(2)=PLACER_"^OR",FIELD(3)=+POERR("PSOFILNM")_"N^PS"
    95         S FIELD(1)="SC",FIELD(5)="DC"
    96         D SEG^PSOHLSN1
    97         I $G(PSODEATH) S MSG(COUNT)=MSG(COUNT)_"|^^^^DATE OF DEATH ENTERED BY MAS.^"
    98         ;
    99         D SEND^PSOHLSN1 K FIELDS,LIMIT,PSODSC,PSONVA,OI
    100         Q
    101         ;
    102 ACT     ;activity log
    103         D NOW^%DTC S NOW=%
    104         S IR=0 F FDA=0:0 S FDA=$O(^PSRX(DA,"A",FDA)) Q:'FDA  S IR=FDA
    105         S IR=IR+1,^PSRX(DA,"A",0)="^52.3DA^"_IR_"^"_IR
    106         S RXF=$S(RXF>5:RXF+1,1:RXF)
    107         S ^PSRX(DA,"A",IR,0)=NOW_"^"_$S(ACT:"U",1:"H")_"^"_POERR("USER")_"^"_RXF_"^"_"RX "_$S('ACT:"placed in a",1:"removed from")_" HOLD status "_$S(+$G(PSUS):"and removed from SUSPENSE ",1:"")_"("_$E(DT,4,5)_"-"_$E(DT,6,7)_"-"_$E(DT,2,3)_") by OERR."
    108         Q
     1PSOORUTL ;ISC BHAM/SAB  - updates order status from oerr ;02/22/95
     2 ;;7.0;OUTPATIENT PHARMACY;**14,46,146,132,118,199,223,148,249**;DEC 1997;Build 9
     3 ;External reference to EN^ORERR - 2187
     4 ;External reference to ^PS(55 - 2228
     5 ;Input variables, poerr("psofilnm")=pharmacy pointer # from OE/RR, poerr("stat")=Order Control status
     6 ;poerr("pharmst")=will contain 'ZE'if rx has expired, poerr("comm")=Comments, poerr("user")=Person placing request
     7EN(POERR) ;
     8 N PSZORS,III
     9 F OO=0:0 S OO=$O(MSG(OO)) Q:'OO  I $P(MSG(OO),"|")="ZRN" S NVA=1
     10 I $G(NVA) G NVA
     11 G:POERR("PSOFILNM")'["S" RXO S III=+POERR("PSOFILNM")
     12 S ORS=0 I $D(^PS(52.41,III,0)) D  G PEXIT
     13 .Q:$P($G(^PS(52.41,III,0)),"^",3)="RF"
     14 .I $G(PDFN),$P($G(^PS(52.41,III,0)),"^",2),PDFN'=$P(^PS(52.41,III,0),"^",2) S ORS=1
     15RXO S III=POERR("PSOFILNM") I $D(^PSRX(III,0)) D  G PEXIT
     16 .I $G(PDFN),$P($G(^PSRX(III,0)),"^",2),PDFN'=$P(^PSRX(III,0),"^",2) S ORS=1
     17 S (ORS,PSZORS)=1
     18PEXIT I $G(ORS) S POERR("STAT")=$S(POERR("STAT")="CA":"UC",POERR("STAT")="DC":"UD",POERR("STAT")="HD":"UH",1:"UR"),POERR("FILLER")="",POERR("COMM")=$S($G(PSZORS):"Unable to locate order.",1:"Patient does not match.") K ORS,PSZORS,III Q
     19 S POERR("PHARMST")="" G:POERR("STAT")="HD"!(POERR("STAT")="RL") HD
     20 S ORS=0 I POERR("PSOFILNM")["S" S DA=+POERR("PSOFILNM") I $D(^PS(52.41,DA,0)) D  G EXIT
     21 .Q:$P($G(^PS(52.41,DA,0)),"^",3)="RF"
     22 .S $P(^PS(52.41,DA,0),"^",3)="DC",POERR("PLACE")=$P(^(0),"^"),POERR("STAT")="CR",POERR("FILLER")=DA_"^P"
     23 .K ^PS(52.41,"AOR",+$P($G(^PS(52.41,DA,0)),"^",2),+$P($G(^PS(52.41,DA,"INI")),"^"),DA)
     24 .S:$G(POERR("COMM"))']"" POERR("COMM")="Order Canceled by OE/RR before finishing." S ORS=1,$P(^PS(52.41,DA,4),"^")=$G(POERR("COMM"))
     25 S DA=POERR("PSOFILNM") D:$D(^PSRX(DA,0)) REVERSE^PSOBPSU1(DA,,"DC",7)
     26 I $D(^PSRX(DA,0)) D  S $P(^PSRX(DA,"STA"),"^")=14,$P(^PSRX(DA,3),"^",5)=DT,$P(^PSRX(DA,3),"^",10)=$P(^PSRX(DA,3),"^") D CAN^PSOTPCAN(DA) G EXIT
     27 .;cancel/discontinue action
     28 .S POERR("PLACE")=+$P($G(^PSRX(DA,"OR1")),"^",2),POERR("STAT")=$S(POERR("STAT")="CA":"CR",1:"DR"),POERR("FILLER")=DA_"^R"
     29 .S:'$D(POERR("COMM")) POERR("COMM")="Prescription DISCONTINUED by OERR"
     30 .S ORS=1 D CAN
     31EXIT I '$G(ORS) D
     32 .S POERR("STAT")=$S(POERR("STAT")="CA":"UC",POERR("STAT")="DC":"UD",POERR("STAT")="HD":"UH",1:"UR"),POERR("FILLER")="",POERR("COMM")="Order was not located by Pharmacy"
     33 K EXP,ORS,DA,ACOM,RXDA,SUSD,PSUS,RXF,I,FDA,DIC,DIE,DR,Y,X,%,%I,%H,RSDT,ACNT,ACT,DIK,FDT,IR,LFD,NOW,ORD,PSDA,PSCDA,PSODFN,PSUS,RF,RFCNT,RXN,RXP,RXREF,SD,SUB
     34 Q
     35CAN S ACOM="Discontinued by OE/RR." I $P(^PSRX(DA,"STA"),"^")=3!($P(^("STA"),"^")=16) D
     36 .S ACOM="Discontinued by OE/RR while on hold. " K:$P(^PSRX(DA,"H"),"^") ^PSRX("AH",$P(^PSRX(DA,"H"),"^"),DA) S ^PSRX(DA,"H")=""
     37 .I $P(^PSRX(DA,0),"^",13),'$O(^PSRX(DA,1,0)) S DIE=52,DR="22///"_$E($P(^PSRX(DA,0),"^",13),1,7) D ^DIE K DIE,DR Q
     38 .S (IFN,SUSD)=0 F  S IFN=$O(^PSRX(DA,1,IFN)) Q:'IFN  S SUSD=IFN,RFDT=$P(^PSRX(DA,1,IFN,0),"^")
     39 .Q:'$G(SUSD)  I '$P(^PSRX(DA,1,SUSD,0),"^",18) S PSDTEST=0 D  I 'PSDTEST K ^PSRX(DA,1,SUSD),^PSRX("AD",RFDT,DA,SUSD),^PSRX(DA,1,"B",RFDT,SUSD),IFN,SUSD,RFDT
     40 ..F PDA=0:0 S PDA=$O(^PSRX(DA,"L",PDA)) Q:'PDA  I $P($G(^PSRX(DA,"L",PDA,0)),"^",2)=SUSD S PSDTEST=1
     41 ..K CMOP D ^PSOCMOPA I $G(CMOP(CMOP("L")))="",$G(CMOP("S"))'="L" Q
     42 ..S PSDTEST=1
     43 S RXDA=DA,(DA,SUSDA)=$O(^PS(52.5,"B",DA,0)) D:DA
     44 .S SUSD=$P($G(^PS(52.5,DA,0)),"^",2)
     45 .S:+$G(^PS(52.5,DA,"P"))'=1 ACOM="Discontinued by OE/RR while suspended."
     46 .I $O(^PSRX(RXDA,1,0)) S DA=RXDA D:'$G(^PS(52.5,+SUSDA,"P")) REF^PSOCAN2
     47 .S DA=SUSDA,DIK="^PS(52.5," D ^DIK K DIK
     48 K SUSD,SUSDA S DA=RXDA,RXREF=0,PSODFN=+$P(^PSRX(DA,0),"^",2) D
     49 .S ACNT=0 F SUB=0:0 S SUB=$O(^PSRX(DA,"A",SUB)) Q:'SUB  S ACNT=SUB
     50 .S RFCNT=0 F RF=0:0 S RF=$O(^PSRX(DA,1,RF)) Q:'RF  S RFCNT=RF S:RF>5 RFCNT=RF+1
     51 .D NOW^%DTC S ^PSRX(DA,"A",0)="^52.3DA^"_(ACNT+1)_"^"_(ACNT+1),^PSRX(DA,"A",ACNT+1,0)=%_"^C^"_POERR("USER")_"^"_RFCNT_"^"_$G(ACOM)
     52 .S REA="C" D EXP^PSOHELP1
     53 I $G(^PS(52.4,DA,0))]"" S PSCDA=DA,DIK="^PS(52.4," D ^DIK S DA=PSCDA K DIK,PSCDA
     54 Q
     55HD ;place order on hold
     56 G:POERR("STAT")="RL" REL^PSOORUT1 S (ACT,ORS)=0 I POERR("PSOFILNM")["S" D  G EXIT
     57 .S DA=+POERR("PSOFILNM")
     58 .Q:'$D(^PS(52.41,DA,0))  Q:$P(^PS(52.41,DA,0),"^",3)="RF"
     59 .S $P(^PS(52.41,DA,0),"^",3)="HD",POERR("STAT")="HR",POERR("FILLER")=DA_"^P"
     60 .S:$G(POERR("COMM"))']"" POERR("COMM")="Order PLACED on HOLD by OERR before finished." S $P(^PS(52.41,DA,4),"^")=POERR("COMM"),ORS=1
     61 S DA=POERR("PSOFILNM") I $D(^PSRX(DA,0)) S ORS=1,PSDA=DA D  G EXIT
     62 .S POERR("FILLER")=DA_"^R"
     63 .S:'$D(POERR("COMM")) POERR("COMM")="Prescription Placed on HOLD by OERR"
     64 .I DT>$P(^PSRX(DA,2),"^",6) S EXP=$P(^(2),"^",6) S:$P(^PSRX(DA,"STA"),"^")<12 $P(^PSRX(DA,"STA"),"^")=11,PSOEXFLG=1 S POERR("STAT")="UH",POERR("COMM")="Prescription EXPIRED on "_$E(EXP,4,5)_"/"_$E(EXP,6,7)_"/"_$E(EXP,2,3)_"." D  Q
     65 ..D ECAN^PSOUTL(DA)
     66 .I $P(^PSRX(DA,"STA"),"^")=3!($P(^("STA"),"^")>11) S POERR("STAT")="UH",POERR("COMM")="Unable to place on HOLD" Q
     67 .S $P(^PSRX(DA,"STA"),"^")=16,POERR("STAT")="HR",^PSRX(DA,"H")=99_"^"_POERR("COMM")_"^"_DT
     68 .S (PSUS,RXF)=0 F I=0:0 S I=$O(^PSRX(DA,1,I)) Q:'I  S RXF=I S:RXF>1 RSDT=$P(^(RXF-1,0),"^")
     69 .S DA=PSDA D ACT D REVERSE^PSOBPSU1(DA,,"HLD",2)
     70 .S DA=$O(^PS(52.5,"B",PSDA,0)) I DA S DIK="^PS(52.5,",PSUS=1 D ^DIK K DA,DIK
     71 I 'ORS S POERR("COMM")="Unable to place order on HOLD" G EXIT
     72 Q
     73NVA ;non-va med action
     74 N DIE,DR,DA K NVA
     75 I POERR("PSOFILNM")'["N"!('$D(^PS(55,PDFN,"NVA",+POERR("PSOFILNM"),0))) D EN^ORERR("Order was not located by Pharmacy",.MSG) Q
     76 I $G(OR("STAT"))'="CA",$G(OR("STAT"))'="DC" D EN^ORERR("Invalid Order Control Code",.MSG) Q
     77XO S ORD=+POERR("PSOFILNM")
     78 N TMP
     79 D NOW^%DTC
     80 K TMP S TMP(55.05,ORD_","_PDFN_",",5)=$S($G(PSODEATH):2,1:1)
     81 S TMP(55.05,ORD_","_PDFN_",",6)=%
     82 D FILE^DIE("","TMP")
     83 S PLACER=$P(^PS(55,PDFN,"NVA",ORD,0),"^",8)
     84 K MSG S NULLFLDS="F JJ=0:1:LIMIT S FIELD(JJ)="""""
     85 K ^UTILITY("DIQ1",$J),DIQ S DA=$P($$SITE^VASITE(),"^")
     86 I $G(DA) S DIC=4,DIQ(0)="I",DR="99" D EN^DIQ1 S PSOHINST=$G(^UTILITY("DIQ1",$J,4,DA,99,"I")) K ^UTILITY("DIQ1",$J),DA,DR,DIQ,DIC
     87 S MSG(1)="MSH|^~\&|PHARMACY|"_$G(PSOHINST)_"|||||ORR"
     88 ;
     89 S DFN=PDFN,COUNT=1,LIMIT=5 X NULLFLDS D DEM^VADPT S NAME=$G(VADM(1)) K VADM
     90 S FIELD(0)="PID",FIELD(3)=DFN,FIELD(5)=NAME
     91 D SEG^PSOHLSN1
     92 ;
     93 S LIMIT=15 X NULLFLDS
     94 S FIELD(0)="ORC",FIELD(2)=PLACER_"^OR",FIELD(3)=+POERR("PSOFILNM")_"N^PS"
     95 S FIELD(1)="SC",FIELD(5)="DC"
     96 D SEG^PSOHLSN1
     97 I $G(PSODEATH) S MSG(COUNT)=MSG(COUNT)_"|^^^^DATE OF DEATH ENTERED BY MAS.^"
     98 ;
     99 D SEND^PSOHLSN1 K FIELDS,LIMIT,PSODSC,PSONVA,OI
     100 Q
     101 ;
     102ACT ;activity log
     103 D NOW^%DTC S NOW=%
     104 S IR=0 F FDA=0:0 S FDA=$O(^PSRX(DA,"A",FDA)) Q:'FDA  S IR=FDA
     105 S IR=IR+1,^PSRX(DA,"A",0)="^52.3DA^"_IR_"^"_IR
     106 S ^PSRX(DA,"A",IR,0)=NOW_"^"_$S(ACT:"U",1:"H")_"^"_POERR("USER")_"^"_RXF_"^"_"RX "_$S('ACT:"placed in a",1:"removed from")_" HOLD status "_$S(+$G(PSUS):"and removed from SUSPENSE ",1:"")_"("_$E(DT,4,5)_"-"_$E(DT,6,7)_"-"_$E(DT,2,3)_") by OERR."
     107 Q
Note: See TracChangeset for help on using the changeset viewer.