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/PSOORRL.m

    r613 r623  
    1 PSOORRL ;BHAM ISC/SAB - returns patient's outpatient meds ;07/21/96
    2         ;;7.0;OUTPATIENT PHARMACY;**4,20,9,34,54,82,124,132,159,214,225**;DEC 1997;Build 29
    3         ;External reference to ^PS(55 supported by DBIA 2228
    4         ;External reference to ^PSDRUG supported by DBIA 221
    5         ;External reference to ^VA(200 supported by DBIA 10060
    6         ;External reference to ^PS(51.2 supported by DBIA 2226
    7         ;External reference to ^PS(50.7 supported by DBIA 2223
    8         ;External reference to ^PS(50.606 supported by DBIA 2174
    9         ;External reference to OCL^PSJORRE supported by DBIA 2383
    10         ;External reference to OEL^PSJORRE1 supported by DBIA 2384
    11 OCL(DFN,BDT,EDT,VIEW)   ;entry point to return condensed list
    12         ; VIEW=0   -  This returns the list as it was returned prior to GUI 27
    13         ; VIEW=1   -  This returns the list in original view GUI 27
    14         ; VIEW=2   -  This is the new sort with GUI 27
    15         ; VIEW=3   -  New sort by Sort by Drug Name/status with GUI 27
    16         D @$S($G(VIEW)=3:"OCL^PSOORRL3",$G(VIEW)=1:"OCL^PSOORRLO",$G(VIEW)=2:"OCL^PSOORRLN",1:"ST")
    17         Q
    18         ;BHW;PSO*7*159;New SD* Variables
    19 ST      N SD,SDT,SDT1
    20         D:$P($G(^PS(55,DFN,0)),"^",6)'=2 EN^PSOHLUP(DFN)
    21         K ^TMP("PS",$J) S TFN=0,PSBDT=$G(BDT),PSEDT=$G(EDT) I +$G(PSBDT)<1 S X1=DT,X2=-120 D C^%DTC S PSBDT=X
    22         S EXDT=PSBDT-1,IFN=0
    23         F  S EXDT=$O(^PS(55,DFN,"P","A",EXDT)) Q:'EXDT  F  S IFN=$O(^PS(55,DFN,"P","A",EXDT,IFN)) Q:'IFN  D:$D(^PSRX(IFN,0))
    24         .Q:$P($G(^PSRX(IFN,"STA")),"^")=13
    25         .S TFN=TFN+1,RX0=^PSRX(IFN,0),RX2=$G(^(2)),RX3=$G(^(3)),STA=+$G(^("STA")),TRM=0,LSTFD=$P(RX2,"^",2),LSTRD=$P(RX2,"^",13),LSTDS=$P(RX0,"^",8)
    26         .F I=0:0 S I=$O(^PSRX(IFN,1,I)) Q:'I  S TRM=TRM+1,LSTFD=$P(^PSRX(IFN,1,I,0),"^"),LSTDS=$P(^(0),"^",10) S:$P(^(0),"^",18)]"" LSTRD=$P(^(0),"^",18)
    27         .S ^TMP("PS",$J,TFN,0)=IFN_"R;O"_"^"_$P($G(^PSDRUG(+$P(RX0,"^",6),0)),"^")_"^^"_$P(RX2,"^",6)_"^"_($P(RX0,"^",9)-TRM)_"^^^"_$P($G(^PSRX(IFN,"OR1")),"^",2)
    28         .S ^TMP("PS",$J,TFN,"P",0)=$P(RX0,"^",4)_"^"_$P($G(^VA(200,+$P(RX0,"^",4),0)),"^")
    29         .S ST0=$S(STA<12&($P(RX2,"^",6)<DT):11,1:STA)
    30         .S ST=$P("ERROR^ACTIVE^NON-VERIFIED^REFILL FILL^HOLD^NON-VERIFIED^ACTIVE/SUSP^^^^^DONE^EXPIRED^DISCONTINUED^DISCONTINUED^DISCONTINUED^DISCONTINUED (EDIT)^HOLD^","^",ST0+2)
    31         .S ^TMP("PS",$J,TFN,0)=^TMP("PS",$J,TFN,0)_"^"_ST_"^"_LSTFD_"^"_$P(RX0,"^",8)_"^"_$P(RX0,"^",7)_"^^^"_$P(RX0,"^",13)_"^"_LSTRD_"^"_LSTDS
    32         .S ^TMP("PS",$J,TFN,"SCH",0)=0
    33         .S (SCH,SC)=0 F  S SC=$O(^PSRX(IFN,"SCH",SC)) Q:'SC  S SCH=SCH+1,^TMP("PS",$J,TFN,"SCH",SCH,0)=$P(^PSRX(IFN,"SCH",SC,0),"^"),^TMP("PS",$J,TFN,"SCH",0)=^TMP("PS",$J,TFN,"SCH",0)+1
    34         .S ^TMP("PS",$J,TFN,"MDR",0)=0,(MDR,MR)=0 F  S MR=$O(^PSRX(IFN,"MEDR",MR)) Q:'MR  D
    35         ..Q:'$D(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0))  S MDR=MDR+1
    36         ..I $P($G(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0)),"^",3)]"" S ^TMP("PS",$J,TFN,"MDR",MDR,0)=$P(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0),"^",3)
    37         ..I $D(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0)),$P($G(^(0)),"^",3)']"" S ^TMP("PS",$J,TFN,"MDR",MDR,0)=$P(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0),"^")
    38         ..S ^TMP("PS",$J,TFN,"MDR",0)=^TMP("PS",$J,TFN,"MDR",0)+1
    39         .S PSOELSE=0 I $D(^PSRX(IFN,"SIG")),'$P(^PSRX(IFN,"SIG"),"^",2) S PSOELSE=1 S X=$P(^PSRX(IFN,"SIG"),"^") D SIG1^PSOORRL1
    40         .I '$G(PSOELSE) S ITFN=1 D
    41         ..S ^TMP("PS",$J,TFN,"SIG",ITFN,0)=$G(^PSRX(IFN,"SIG1",1,0)),^TMP("PS",$J,TFN,"SIG",0)=+$G(^TMP("PS",$J,TFN,"SIG",0))+1
    42         ..F I=1:0 S I=$O(^PSRX(IFN,"SIG1",I)) Q:'I  S ITFN=ITFN+1,^TMP("PS",$J,TFN,"SIG",ITFN,0)=^PSRX(IFN,"SIG1",I,0),^TMP("PS",$J,TFN,"SIG",0)=+$G(^TMP("PS",$J,TFN,"SIG",0))+1
    43         K PSOELSE
    44         S IFN=0 F  S IFN=$O(^PS(52.41,"P",DFN,IFN)) Q:'IFN  S PSOR=^PS(52.41,IFN,0) D:$P(PSOR,"^",3)="" WAIT D:$P(PSOR,"^",3)'="DC"&($P(PSOR,"^",3)'="DE")&($P(PSOR,"^",3)'="")
    45         .Q:$P(PSOR,"^",3)="RF"
    46         .I $P(PSOR,"^",8)="",$P(PSOR,"^",9)="" D WAIT
    47         .I $P(PSOR,"^",8)="",$P(PSOR,"^",9)="" Q  ; QUIT IF STILL NULL AFTER WAITING
    48         .S TFN=TFN+1,^TMP("PS",$J,TFN,0)=IFN_"P;O^"_$S($P(PSOR,"^",9):$P($G(^PSDRUG($P(PSOR,"^",9),0)),"^"),1:$P(^PS(50.7,$P(PSOR,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(PSOR,"^",8),0),"^",2),0),"^"))
    49         .S ^TMP("PS",$J,TFN,0)=^TMP("PS",$J,TFN,0)_"^^^^^^"_$P(PSOR,"^")_"^"_"PENDING^^^"_$P(PSOR,"^",10)_"^"
    50         .S ^TMP("PS",$J,TFN,0)=^TMP("PS",$J,TFN,0)_"^"_$S($P(PSOR,"^",3)="RNW":1,1:0)
    51         .S SD=0 F SCH=0:0 S SCH=$O(^PS(52.41,IFN,1,SCH)) Q:'SCH  S SD=SD+1,^TMP("PS",$J,TFN,"SCH",SD,0)=$P(^PS(52.41,IFN,1,SCH,1),"^"),^TMP("PS",$J,TFN,"SCH",0)=SD
    52         .S SD=0 F SCH=0:0 S SCH=$O(^PS(52.41,IFN,"SIG",SCH)) Q:'SCH  S SD=SD+1,^TMP("PS",$J,TFN,"SIG",SD,0)=$P(^PS(52.41,IFN,"SIG",SCH,0),"^"),^TMP("PS",$J,TFN,"SIG",0)=SD
    53         .S (IEN,SD)=1,INST=0 F  S INST=$O(^PS(52.41,IFN,2,INST)) Q:'INST  S (MIG,INST(INST))=^PS(52.41,IFN,2,INST,0),^TMP("PS",$J,TFN,"SIO",0)=SD D
    54         ..F SG=1:1:$L(MIG," ") S:$L($G(^TMP("PS",$J,TFN,"SIO",IEN,0))_" "_$P(MIG," ",SG))>80 IEN=IEN+1,SD=SD+1,^TMP("PS",$J,TFN,"SIO",0)=SD S ^TMP("PS",$J,TFN,"SIO",IEN,0)=$G(^TMP("PS",$J,TFN,"SIO",IEN,0))_" "_$P(MIG," ",SG)
    55         D NVA,OCL^PSJORRE(DFN,BDT,EDT,.TFN,+$G(VIEW)),END^PSOORRL1
    56         K SDT,SDT1,EDT,EDT1,BDT,DBT1,X
    57         Q
    58 OEL(DFN,RXNUM)  ;returns expanded list on specific order
    59         I $P(RXNUM,";",2)="I" D OEL^PSJORRE1(DFN,$P(RXNUM,";")) Q
    60         D:$P($G(^PS(55,DFN,0)),"^",6)'=2 EN^PSOHLUP(DFN) Q:RXNUM=""
    61         ;BHW;PSO*7*159;New SD
    62         N SD
    63         K INST,IFN,^TMP("PS",$J) S FL=$P(RXNUM,";"),IFN=+FL,RXNUM=$P(RXNUM,";",2)
    64         I $G(FL)["P"!($G(FL)["S") D PEN^PSOORRL1 Q
    65         I $G(FL)["N" D NVA^PSOORRL1 Q
    66         Q:'$D(^PSRX(IFN,0))
    67         S RX0=^PSRX(IFN,0),RX2=$G(^(2)),RX3=$G(^(3)),STA=+$G(^("STA")),TRM=0,LSTFD=$P(RX2,"^",2)
    68         S ^TMP("PS",$J,"RXN",0)=$P(RX0,"^")_"^"_$E($P(RX2,"^",13),1,7)_"^"_$S($P(RX0,"^",11)="W":"W",1:"M")_"^"_$P(RX3,"^",7)_"^"_$S($P($G(^PSRX(IFN,"OR1")),"^",5):$P(^PSRX(IFN,"OR1"),"^",5),1:"")_"^"_$E($P(RX2,"^",2),1,7)_"^"_$E($P(RX2,"^",13),1,7)
    69         D RSTC(0) ;set return to stock node for original
    70         F I=0:0 S I=$O(^PSRX(IFN,1,I)) Q:'I  S TRM=TRM+1,LSTFD=$P(^PSRX(IFN,1,I,0),"^") D
    71         .S ^TMP("PS",$J,"REF",I,0)=$P(^PSRX(IFN,1,I,0),"^")_"^"_$P(^(0),"^",10)_"^"_$P(^(0),"^",4)_"^"_$E($P(^(0),"^",18),1,7)_"^"_$S($P(^(0),"^",2)="W":"W",1:"M")_"^"_$P(^(0),"^",3)
    72         .I $P(^PSRX(IFN,1,I,0),"^",18) S $P(^TMP("PS",$J,"RXN",0),"^",2)=$E($P(^PSRX(IFN,1,I,0),"^",18),1,7)
    73         .S ^TMP("PS",$J,"REF",0)=$G(^TMP("PS",$J,"REF",0))+1
    74         .D RSTC(I) ;set return to stock node for refills
    75         F I=0:0 S I=$O(^PSRX(IFN,"P",I)) Q:'I  D
    76         .S ^TMP("PS",$J,"PAR",I,0)=$P(^PSRX(IFN,"P",I,0),"^")_"^"_$P(^(0),"^",10)_"^"_$P(^(0),"^",4)_"^"_$E($P(^(0),"^",19),1,7)_"^"_$S($P(^(0),"^",2)="W":"W",1:"M")_"^"_$P(^(0),"^",3)
    77         .S ^TMP("PS",$J,"PAR",0)=$G(^TMP("PS",$J,"PAR",0))+1
    78         S ^TMP("PS",$J,0)=$P($G(^PSDRUG(+$P(RX0,"^",6),0)),"^")_"^^"_$P(RX2,"^",6)
    79         S ^TMP("PS",$J,"P",0)=$P(RX0,"^",4)_"^"_$P($G(^VA(200,+$P(RX0,"^",4),0)),"^")
    80         S ST0=$S(STA<12&($P(RX2,"^",6)<DT):11,1:STA)
    81         S ST=$P("ERROR^ACTIVE^NON-VERIFIED^REFILL FILL^HOLD^NON-VERIFIED^ACTIVE/SUSP^^^^^DONE^EXPIRED^DISCONTINUE^DISCONTINUED^DISCONTINUED^DISCONTINUED (EDIT)^HOLD^","^",ST0+2)
    82         S ^TMP("PS",$J,0)=^TMP("PS",$J,0)_"^"_($P(RX0,"^",9)-TRM)_"^"_$P(RX0,"^",13)_"^"_ST_"^"_$P(RX0,"^",8)_"^"_$P(RX0,"^",7)_"^^^"_$P($G(^PSRX(IFN,"OR1")),"^",2)_"^"_LSTFD_"^^"
    83         S ^TMP("PS",$J,"DD",0)=1,^TMP("PS",$J,"DD",1,0)=$P(RX0,"^",6)_"^^"
    84         S COD=$S('$G(^PSDRUG(+$P(RX0,"^",6),"I")):1,+$G(^PSDRUG(+$P(RX0,"^",6),"I"))>DT:1,1:0)
    85         S ^TMP("PS",$J,"DD",1,0)=^TMP("PS",$J,"DD",1,0)_$S($P($G(^PSDRUG(+$P(RX0,"^",6),2)),"^",3)["U"&(COD):$P(RX0,"^",6),1:"") K COD
    86         S ^TMP("PS",$J,"SCH",0)=0,(SCH,SC)=0
    87         F  S SC=$O(^PSRX(IFN,"SCH",SC)) Q:'SC  S SCH=SCH+1,^TMP("PS",$J,"SCH",SCH,0)=$P(^PSRX(IFN,"SCH",SC,0),"^") D
    88         .S ^TMP("PS",$J,"SCH",0)=^TMP("PS",$J,"SCH",0)+1
    89         D MDR^PSOORRL1
    90         S PSOELSE=0 I $D(^PSRX(IFN,"SIG")),'$P(^PSRX(IFN,"SIG"),"^",2) S PSOELSE=1 S X=$P(^PSRX(IFN,"SIG"),"^") D SIG^PSOORRL1
    91         I '$G(PSOELSE) S ITFN=1 D
    92         .S ^TMP("PS",$J,"SIG",ITFN,0)=$G(^PSRX(IFN,"SIG1",1,0)),^TMP("PS",$J,"SIG",0)=+$G(^TMP("PS",$J,"SIG",0))+1
    93         .F I=1:0 S I=$O(^PSRX(IFN,"SIG1",I)) Q:'I  S ITFN=ITFN+1,^TMP("PS",$J,"SIG",ITFN,0)=^PSRX(IFN,"SIG1",I,0),^TMP("PS",$J,"SIG",0)=+$G(^TMP("PS",$J,"SIG",0))+1
    94         K PSOELSE
    95         S ^TMP("PS",$J,"PC",0)=0,ITFN=0
    96         F I=0:0 S I=$O(^PSRX(IFN,"PRC",I)) Q:'I  S ITFN=ITFN+1,^TMP("PS",$J,"PC",ITFN,0)=^PSRX(IFN,"PRC",I,0),^TMP("PS",$J,"PC",0)=^TMP("PS",$J,"PC",0)+1
    97         Q
    98         ;
    99 WAIT    ; IF PENDING ENTRY STILL BEING BUILT SEE IF IT COMPLETES WITHIN ANOTHER SECOND
    100         H 1 S PSOR=$G(^PS(52.41,IFN,0))
    101         Q
    102         ;
    103 NVA     ; Set Non-VA Med Orders in the ^TMP Global
    104         ;BHW;PSO*7*159;New SDT,SDT1 Variables
    105         N SDT,SDT1
    106         F I=0:0 S I=$O(^PS(55,DFN,"NVA",I)) Q:'I  S X=$G(^PS(55,DFN,"NVA",I,0)) D
    107         .Q:'$P(X,"^")
    108         .S DRG=$S($P(X,"^",2):$P($G(^PSDRUG($P(X,"^",2),0)),"^"),1:$P(^PS(50.7,$P(X,"^"),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(X,"^"),0),"^",2),0),"^"))
    109         .S SDT=$P(X,"^",9) I 'SDT D TMPBLD Q
    110         .I $E(SDT,4,5),$E(SDT,6,7) D
    111         ..;I $P(X,"^",9) D  Q
    112         ..I $G(BDT),SDT<BDT Q
    113         ..I $G(EDT),SDT>EDT Q
    114         ..I $G(BDT),$P(X,"^",7),$P(X,"^",7)<BDT Q
    115         ..D TMPBLD
    116         .I $E(SDT,4,5),'$E(SDT,6,7) D
    117         ..S SDT1=$E(SDT,1,5),BDT1=$E(+$G(BDT),1,5),EDT1=$E(+$G(EDT),1,5)
    118         ..I $G(BDT1),SDT1<BDT1 Q
    119         ..I $G(EDT1),SDT1>EDT1 Q
    120         ..I $G(BDT1),$P(X,"^",7),$E($P(X,"^",7),1,5)<BDT1 Q
    121         ..D TMPBLD
    122         .I '$E(SDT,4,5),'$E($P(X,"^",9),6,7) D
    123         ..;I $P(X,"^",9) D  Q
    124         ..S SDT1=$E(SDT,1,3),BDT1=$E(+$G(BDT),1,3),EDT1=$E(+$G(EDT),1,3)
    125         ..I $G(BDT1),SDT1<BDT1 Q
    126         ..I $G(EDT1),SDT1>EDT1 Q
    127         ..I $G(BDT1),$P(X,"^",7),$E($P(X,"^",7),1,3)<BDT1 Q
    128         ..D TMPBLD
    129         Q
    130 TMPBLD  S TFN=$G(TFN)+1,^TMP("PS",$J,TFN,0)=I_"N;O^"_DRG
    131         S $P(^TMP("PS",$J,TFN,0),"^",8)=$P(X,"^",8)_"^"_$S($P(X,"^",7):"DISCONTINUED",1:"ACTIVE")
    132         S ^TMP("PS",$J,TFN,"SCH",0)=1,^TMP("PS",$J,TFN,"SCH",1,0)=$P(X,"^",5)
    133         S ^TMP("PS",$J,TFN,"SIG",0)=1,^TMP("PS",$J,TFN,"SIG",1,0)=$P(X,"^",3)_" "_$P(X,"^",4)_" "_$P(X,"^",5)
    134         Q
    135 RSTC(REF)       ; return to stock
    136         F J=0:0 S J=$O(^PSRX(IFN,"A",J)) Q:'J  S II=$G(^(J,0)) I $P(II,"^",2)="I",$P(II,"^",4)=REF D
    137         .I REF=0,'$$RXRLDT^PSOBPSUT(IFN,0) S ^TMP("PS",$J,"RXN","RSTC")=$P(II,"^")_"^"_$P(II,"^",3)_"^"_$P(II,"^",5) Q
    138         .I REF>0,'$$RXRLDT^PSOBPSUT(IFN,REF) S ^TMP("PS",$J,"REF",REF,"RSTC")=$P(II,"^")_"^"_$P(II,"^",3)_"^"_$P(II,"^",5)
    139         Q
     1PSOORRL ;BHAM ISC/SAB - returns patient's outpatient meds ;07/21/96
     2 ;;7.0;OUTPATIENT PHARMACY;**4,20,9,34,54,82,124,132,159,214**;DEC 1997
     3 ;External reference to ^PS(55 supported by DBIA 2228
     4 ;External reference to ^PSDRUG supported by DBIA 221
     5 ;External reference to ^VA(200 supported by DBIA 10060
     6 ;External reference to ^PS(51.2 supported by DBIA 2226
     7 ;External reference to ^PS(50.7 supported by DBIA 2223
     8 ;External reference to ^PS(50.606 supported by DBIA 2174
     9 ;External reference to OCL^PSJORRE supported by DBIA 2383
     10 ;External reference to OEL^PSJORRE1 supported by DBIA 2384
     11OCL(DFN,BDT,EDT) ;entry point to return condensed list
     12 ;BHW;PSO*7*159;New SD* Variables
     13 N SD,SDT,SDT1
     14 D:$P($G(^PS(55,DFN,0)),"^",6)'=2 EN^PSOHLUP(DFN)
     15 K ^TMP("PS",$J) S TFN=0,PSBDT=$G(BDT),PSEDT=$G(EDT) I +$G(PSBDT)<1 S X1=DT,X2=-120 D C^%DTC S PSBDT=X
     16 S EXDT=PSBDT-1,IFN=0
     17 F  S EXDT=$O(^PS(55,DFN,"P","A",EXDT)) Q:'EXDT  F  S IFN=$O(^PS(55,DFN,"P","A",EXDT,IFN)) Q:'IFN  D:$D(^PSRX(IFN,0))
     18 .Q:$P($G(^PSRX(IFN,"STA")),"^")=13
     19 .S TFN=TFN+1,RX0=^PSRX(IFN,0),RX2=$G(^(2)),RX3=$G(^(3)),STA=+$G(^("STA")),TRM=0,LSTFD=$P(RX2,"^",2),LSTRD=$P(RX2,"^",13),LSTDS=$P(RX0,"^",8)
     20 .F I=0:0 S I=$O(^PSRX(IFN,1,I)) Q:'I  S TRM=TRM+1,LSTFD=$P(^PSRX(IFN,1,I,0),"^"),LSTDS=$P(^(0),"^",10) S:$P(^(0),"^",18)]"" LSTRD=$P(^(0),"^",18)
     21 .S ^TMP("PS",$J,TFN,0)=IFN_"R;O"_"^"_$P($G(^PSDRUG(+$P(RX0,"^",6),0)),"^")_"^^"_$P(RX2,"^",6)_"^"_($P(RX0,"^",9)-TRM)_"^^^"_$P($G(^PSRX(IFN,"OR1")),"^",2)
     22 .S ^TMP("PS",$J,TFN,"P",0)=$P(RX0,"^",4)_"^"_$P($G(^VA(200,+$P(RX0,"^",4),0)),"^")
     23 .S ST0=$S(STA<12&($P(RX2,"^",6)<DT):11,1:STA)
     24 .S ST=$P("ERROR^ACTIVE^NON-VERIFIED^REFILL FILL^HOLD^NON-VERIFIED^ACTIVE/SUSP^^^^^DONE^EXPIRED^DISCONTINUED^DISCONTINUED^DISCONTINUED^DISCONTINUED (EDIT)^HOLD^","^",ST0+2)
     25 .S ^TMP("PS",$J,TFN,0)=^TMP("PS",$J,TFN,0)_"^"_ST_"^"_LSTFD_"^"_$P(RX0,"^",8)_"^"_$P(RX0,"^",7)_"^^^"_$P(RX0,"^",13)_"^"_LSTRD_"^"_LSTDS
     26 .S ^TMP("PS",$J,TFN,"SCH",0)=0
     27 .S (SCH,SC)=0 F  S SC=$O(^PSRX(IFN,"SCH",SC)) Q:'SC  S SCH=SCH+1,^TMP("PS",$J,TFN,"SCH",SCH,0)=$P(^PSRX(IFN,"SCH",SC,0),"^"),^TMP("PS",$J,TFN,"SCH",0)=^TMP("PS",$J,TFN,"SCH",0)+1
     28 .S ^TMP("PS",$J,TFN,"MDR",0)=0,(MDR,MR)=0 F  S MR=$O(^PSRX(IFN,"MEDR",MR)) Q:'MR  D
     29 ..Q:'$D(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0))  S MDR=MDR+1
     30 ..I $P($G(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0)),"^",3)]"" S ^TMP("PS",$J,TFN,"MDR",MDR,0)=$P(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0),"^",3)
     31 ..I $D(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0)),$P($G(^(0)),"^",3)']"" S ^TMP("PS",$J,TFN,"MDR",MDR,0)=$P(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0),"^")
     32 ..S ^TMP("PS",$J,TFN,"MDR",0)=^TMP("PS",$J,TFN,"MDR",0)+1
     33 .S PSOELSE=0 I $D(^PSRX(IFN,"SIG")),'$P(^PSRX(IFN,"SIG"),"^",2) S PSOELSE=1 S X=$P(^PSRX(IFN,"SIG"),"^") D SIG1^PSOORRL1
     34 .I '$G(PSOELSE) S ITFN=1 D
     35 ..S ^TMP("PS",$J,TFN,"SIG",ITFN,0)=$G(^PSRX(IFN,"SIG1",1,0)),^TMP("PS",$J,TFN,"SIG",0)=+$G(^TMP("PS",$J,TFN,"SIG",0))+1
     36 ..F I=1:0 S I=$O(^PSRX(IFN,"SIG1",I)) Q:'I  S ITFN=ITFN+1,^TMP("PS",$J,TFN,"SIG",ITFN,0)=^PSRX(IFN,"SIG1",I,0),^TMP("PS",$J,TFN,"SIG",0)=+$G(^TMP("PS",$J,TFN,"SIG",0))+1
     37 K PSOELSE
     38 S IFN=0 F  S IFN=$O(^PS(52.41,"P",DFN,IFN)) Q:'IFN  S PSOR=^PS(52.41,IFN,0) D:$P(PSOR,"^",3)="" WAIT D:$P(PSOR,"^",3)'="DC"&($P(PSOR,"^",3)'="DE")&($P(PSOR,"^",3)'="")
     39 .Q:$P(PSOR,"^",3)="RF"
     40 .I $P(PSOR,"^",8)="",$P(PSOR,"^",9)="" D WAIT
     41 .I $P(PSOR,"^",8)="",$P(PSOR,"^",9)="" Q  ; QUIT IF STILL NULL AFTER WAITING
     42 .S TFN=TFN+1,^TMP("PS",$J,TFN,0)=IFN_"P;O^"_$S($P(PSOR,"^",9):$P($G(^PSDRUG($P(PSOR,"^",9),0)),"^"),1:$P(^PS(50.7,$P(PSOR,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(PSOR,"^",8),0),"^",2),0),"^"))
     43 .S ^TMP("PS",$J,TFN,0)=^TMP("PS",$J,TFN,0)_"^^^^^^"_$P(PSOR,"^")_"^"_"PENDING^^^"_$P(PSOR,"^",10)_"^"
     44 .S ^TMP("PS",$J,TFN,0)=^TMP("PS",$J,TFN,0)_"^"_$S($P(PSOR,"^",3)="RNW":1,1:0)
     45 .S SD=0 F SCH=0:0 S SCH=$O(^PS(52.41,IFN,1,SCH)) Q:'SCH  S SD=SD+1,^TMP("PS",$J,TFN,"SCH",SD,0)=$P(^PS(52.41,IFN,1,SCH,1),"^"),^TMP("PS",$J,TFN,"SCH",0)=SD
     46 .S SD=0 F SCH=0:0 S SCH=$O(^PS(52.41,IFN,"SIG",SCH)) Q:'SCH  S SD=SD+1,^TMP("PS",$J,TFN,"SIG",SD,0)=$P(^PS(52.41,IFN,"SIG",SCH,0),"^"),^TMP("PS",$J,TFN,"SIG",0)=SD
     47 .S (IEN,SD)=1,INST=0 F  S INST=$O(^PS(52.41,IFN,2,INST)) Q:'INST  S (MIG,INST(INST))=^PS(52.41,IFN,2,INST,0),^TMP("PS",$J,TFN,"SIO",0)=SD D
     48 ..F SG=1:1:$L(MIG," ") S:$L($G(^TMP("PS",$J,TFN,"SIO",IEN,0))_" "_$P(MIG," ",SG))>80 IEN=IEN+1,SD=SD+1,^TMP("PS",$J,TFN,"SIO",0)=SD S ^TMP("PS",$J,TFN,"SIO",IEN,0)=$G(^TMP("PS",$J,TFN,"SIO",IEN,0))_" "_$P(MIG," ",SG)
     49 D NVA,OCL^PSJORRE(DFN,BDT,EDT,.TFN),END^PSOORRL1
     50 K SDT,SDT1,EDT,EDT1,BDT,DBT1,X
     51 Q
     52OEL(DFN,RXNUM) ;returns expanded list on specific order
     53 I $P(RXNUM,";",2)="I" D OEL^PSJORRE1(DFN,$P(RXNUM,";")) Q
     54 D:$P($G(^PS(55,DFN,0)),"^",6)'=2 EN^PSOHLUP(DFN) Q:RXNUM=""
     55 ;BHW;PSO*7*159;New SD
     56 N SD
     57 K INST,IFN,^TMP("PS",$J) S FL=$P(RXNUM,";"),IFN=+FL,RXNUM=$P(RXNUM,";",2)
     58 I $G(FL)["P"!($G(FL)["S") D PEN^PSOORRL1 Q
     59 I $G(FL)["N" D NVA^PSOORRL1 Q
     60 Q:'$D(^PSRX(IFN,0))
     61 S RX0=^PSRX(IFN,0),RX2=$G(^(2)),RX3=$G(^(3)),STA=+$G(^("STA")),TRM=0,LSTFD=$P(RX2,"^",2)
     62 S ^TMP("PS",$J,"RXN",0)=$P(RX0,"^")_"^"_$E($P(RX2,"^",13),1,7)_"^"_$S($P(RX0,"^",11)="W":"W",1:"M")_"^"_$P(RX3,"^",7)_"^"_$S($P($G(^PSRX(IFN,"OR1")),"^",5):$P(^PSRX(IFN,"OR1"),"^",5),1:"")_"^"_$E($P(RX2,"^",2),1,7)_"^"_$E($P(RX2,"^",13),1,7)
     63 F I=0:0 S I=$O(^PSRX(IFN,1,I)) Q:'I  S TRM=TRM+1,LSTFD=$P(^PSRX(IFN,1,I,0),"^") D
     64 .S ^TMP("PS",$J,"REF",I,0)=$P(^PSRX(IFN,1,I,0),"^")_"^"_$P(^(0),"^",10)_"^"_$P(^(0),"^",4)_"^"_$E($P(^(0),"^",18),1,7)_"^"_$S($P(^(0),"^",2)="W":"W",1:"M")_"^"_$P(^(0),"^",3)
     65 .I $P(^PSRX(IFN,1,I,0),"^",18) S $P(^TMP("PS",$J,"RXN",0),"^",2)=$E($P(^PSRX(IFN,1,I,0),"^",18),1,7)
     66 .S ^TMP("PS",$J,"REF",0)=$G(^TMP("PS",$J,"REF",0))+1
     67 F I=0:0 S I=$O(^PSRX(IFN,"P",I)) Q:'I  D
     68 .S ^TMP("PS",$J,"PAR",I,0)=$P(^PSRX(IFN,"P",I,0),"^")_"^"_$P(^(0),"^",10)_"^"_$P(^(0),"^",4)_"^"_$E($P(^(0),"^",19),1,7)_"^"_$S($P(^(0),"^",2)="W":"W",1:"M")_"^"_$P(^(0),"^",3)
     69 .S ^TMP("PS",$J,"PAR",0)=$G(^TMP("PS",$J,"PAR",0))+1
     70 S ^TMP("PS",$J,0)=$P($G(^PSDRUG(+$P(RX0,"^",6),0)),"^")_"^^"_$P(RX2,"^",6)
     71 S ^TMP("PS",$J,"P",0)=$P(RX0,"^",4)_"^"_$P($G(^VA(200,+$P(RX0,"^",4),0)),"^")
     72 S ST0=$S(STA<12&($P(RX2,"^",6)<DT):11,1:STA)
     73 S ST=$P("ERROR^ACTIVE^NON-VERIFIED^REFILL FILL^HOLD^NON-VERIFIED^ACTIVE/SUSP^^^^^DONE^EXPIRED^DISCONTINUE^DISCONTINUED^DISCONTINUED^DISCONTINUED (EDIT)^HOLD^","^",ST0+2)
     74 S ^TMP("PS",$J,0)=^TMP("PS",$J,0)_"^"_($P(RX0,"^",9)-TRM)_"^"_$P(RX0,"^",13)_"^"_ST_"^"_$P(RX0,"^",8)_"^"_$P(RX0,"^",7)_"^^^"_$P($G(^PSRX(IFN,"OR1")),"^",2)_"^"_LSTFD_"^^"
     75 S ^TMP("PS",$J,"DD",0)=1,^TMP("PS",$J,"DD",1,0)=$P(RX0,"^",6)_"^^"
     76 S COD=$S('$G(^PSDRUG(+$P(RX0,"^",6),"I")):1,+$G(^PSDRUG(+$P(RX0,"^",6),"I"))>DT:1,1:0)
     77 S ^TMP("PS",$J,"DD",1,0)=^TMP("PS",$J,"DD",1,0)_$S($P($G(^PSDRUG(+$P(RX0,"^",6),2)),"^",3)["U"&(COD):$P(RX0,"^",6),1:"") K COD
     78 S ^TMP("PS",$J,"SCH",0)=0,(SCH,SC)=0
     79 F  S SC=$O(^PSRX(IFN,"SCH",SC)) Q:'SC  S SCH=SCH+1,^TMP("PS",$J,"SCH",SCH,0)=$P(^PSRX(IFN,"SCH",SC,0),"^") D
     80 .S ^TMP("PS",$J,"SCH",0)=^TMP("PS",$J,"SCH",0)+1
     81 D MDR^PSOORRL1
     82 S PSOELSE=0 I $D(^PSRX(IFN,"SIG")),'$P(^PSRX(IFN,"SIG"),"^",2) S PSOELSE=1 S X=$P(^PSRX(IFN,"SIG"),"^") D SIG^PSOORRL1
     83 I '$G(PSOELSE) S ITFN=1 D
     84 .S ^TMP("PS",$J,"SIG",ITFN,0)=$G(^PSRX(IFN,"SIG1",1,0)),^TMP("PS",$J,"SIG",0)=+$G(^TMP("PS",$J,"SIG",0))+1
     85 .F I=1:0 S I=$O(^PSRX(IFN,"SIG1",I)) Q:'I  S ITFN=ITFN+1,^TMP("PS",$J,"SIG",ITFN,0)=^PSRX(IFN,"SIG1",I,0),^TMP("PS",$J,"SIG",0)=+$G(^TMP("PS",$J,"SIG",0))+1
     86 K PSOELSE
     87 S ^TMP("PS",$J,"PC",0)=0,ITFN=0
     88 F I=0:0 S I=$O(^PSRX(IFN,"PRC",I)) Q:'I  S ITFN=ITFN+1,^TMP("PS",$J,"PC",ITFN,0)=^PSRX(IFN,"PRC",I,0),^TMP("PS",$J,"PC",0)=^TMP("PS",$J,"PC",0)+1
     89 Q
     90 ;
     91WAIT ; IF PENDING ENTRY STILL BEING BUILT SEE IF IT COMPLETES WITHIN ANOTHER SECOND
     92 H 1 S PSOR=$G(^PS(52.41,IFN,0))
     93 Q
     94 ;
     95NVA ; Set Non-VA Med Orders in the ^TMP Global
     96 ;BHW;PSO*7*159;New SDT,SDT1 Variables
     97 N SDT,SDT1
     98 F I=0:0 S I=$O(^PS(55,DFN,"NVA",I)) Q:'I  S X=$G(^PS(55,DFN,"NVA",I,0)) D
     99 .Q:'$P(X,"^")
     100 .S DRG=$S($P(X,"^",2):$P($G(^PSDRUG($P(X,"^",2),0)),"^"),1:$P(^PS(50.7,$P(X,"^"),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(X,"^"),0),"^",2),0),"^"))
     101 .S SDT=$P(X,"^",9) I 'SDT D TMPBLD Q
     102 .I $E(SDT,4,5),$E(SDT,6,7) D
     103 ..;I $P(X,"^",9) D  Q
     104 ..I $G(BDT),SDT<BDT Q
     105 ..I $G(EDT),SDT>EDT Q
     106 ..I $G(BDT),$P(X,"^",7),$P(X,"^",7)<BDT Q
     107 ..D TMPBLD
     108 .I $E(SDT,4,5),'$E(SDT,6,7) D
     109 ..S SDT1=$E(SDT,1,5),BDT1=$E(+$G(BDT),1,5),EDT1=$E(+$G(EDT),1,5)
     110 ..I $G(BDT1),SDT1<BDT1 Q
     111 ..I $G(EDT1),SDT1>EDT1 Q
     112 ..I $G(BDT1),$P(X,"^",7),$E($P(X,"^",7),1,5)<BDT1 Q
     113 ..D TMPBLD
     114 .I '$E(SDT,4,5),'$E($P(X,"^",9),6,7) D
     115 ..;I $P(X,"^",9) D  Q
     116 ..S SDT1=$E(SDT,1,3),BDT1=$E(+$G(BDT),1,3),EDT1=$E(+$G(EDT),1,3)
     117 ..I $G(BDT1),SDT1<BDT1 Q
     118 ..I $G(EDT1),SDT1>EDT1 Q
     119 ..I $G(BDT1),$P(X,"^",7),$E($P(X,"^",7),1,3)<BDT1 Q
     120 ..D TMPBLD
     121 Q
     122TMPBLD S TFN=$G(TFN)+1,^TMP("PS",$J,TFN,0)=I_"N;O^"_DRG
     123 S $P(^TMP("PS",$J,TFN,0),"^",8)=$P(X,"^",8)_"^"_$S($P(X,"^",7):"DISCONTINUED",1:"ACTIVE")
     124 S ^TMP("PS",$J,TFN,"SCH",0)=1,^TMP("PS",$J,TFN,"SCH",1,0)=$P(X,"^",5)
     125 S ^TMP("PS",$J,TFN,"SIG",0)=1,^TMP("PS",$J,TFN,"SIG",1,0)=$P(X,"^",3)_" "_$P(X,"^",4)_" "_$P(X,"^",5)
     126 Q
Note: See TracChangeset for help on using the changeset viewer.