source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSORUTE.m@ 1474

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

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1PSSORUTE ;OIFO BAY PINES/ELR-CONTINUATION OF PSSORUTL ;07/20/04
2 ;;1.0;PHARMACY DATA MANAGEMENT;**83,93**;9/30/97
3 ;
4 ;Reference to ^PS(52.41 is supported by DBIA # 2844.
5 ;Reference to ^PSRX is supported by DBIA # 2845.
6 ;Reference to ^PS(53.1 is supported by DBIA # 2140.
7 ;
8NU S PSONDU=$S($G(PSONDS)&($G(PSONDU)):$P($G(^PS(50.607,+$G(PSONDU),0)),"^"),1:"")
9 Q
10SETU S PSSUNITX=$P($G(^PSDRUG(PSIEN,"DOS")),"^",2)
11 S PSSUNITX=$S($P($G(^PS(50.607,+$G(PSSUNITX),0)),"^")'=""&($P($G(^(0)),"^")'["/"):$P($G(^(0)),"^"),1:"")
12 Q
13STATUS(PSSDFN,PSSON) ;Return the status of the Pharmacy order
14 ;
15 N ST,TYPE,LEN,PKG,A,STO,RX2,STA,%,Y
16 D NOW^%DTC S %=$P(%,".") I $P(PSSON,";",2)="" Q ""
17 S LEN=$L($P(PSSON,";")),PKG=$P(PSSON,";",2) I PSSON?.N S TYPE="O"
18 I PSSON'?.N S TYPE=$E(PSSON,LEN),PSSON=$E(PSSON,1,LEN-1)
19 I PKG="I" D Q ST
20 . I TYPE="P" S A=$P($G(^PS(53.1,PSSON,0)),"^",9),ST=$$CODES(A,53.1,28) Q
21 . I TYPE="V" S A=$P($G(^PS(55,PSSDFN,"IV",PSSON,0)),"^",17),ST=$$CODES(A,55.01,100) Q
22 . I TYPE="U" S A=$P($G(^PS(55,PSSDFN,5,PSSON,0)),"^",9),ST=$$CODES(A,55.06,28)
23 I PKG="O" D Q ST
24 . I TYPE="P"!(TYPE="S") D Q
25 .. S A=$P($G(^PS(52.41,PSSON,0)),"^",3),ST="" I A]"" S ST="PENDING" Q
26 . I TYPE="N" S A=$P(^PS(55,PSSDFN,"NVA",PSSON,0),"^",7) S ST=$S('A:"ACTIVE",1:"DISCONTINUED") Q
27 . I TYPE="R"!(TYPE="O") S RX2=$G(^PSRX(PSSON,2)),STA=$G(^PSRX(PSSON,"STA")),STO=$S(STA<12&($P(RX2,"^",6)<%):11,1:STA)
28 . S ST=$P("ERROR^ACTIVE^NON-VERIFIED^REFILL FILL^HOLD^NON-VERIFIED^ACTIVE/SUSP^^^^^DONE^EXPIRED^DISCONTINUED^DISCONTINUED^DISCONTINUED^DISCONTINUED (EDIT)^HOLD^","^",STO+2)
29 Q ""
30CODES(PSSCD,PSSF,PSSFLD) ; Get name from code.
31 ; PSSF = one of following files: ^PS(55, ^PS(53.1, ^PS(52.6, ^PS(52.41
32 N PSSDD,Y
33 D FIELD^DID(PSSF,PSSFLD,"","POINTER","PSSDD")
34 S Y=$G(PSSDD("POINTER")) K PSSDD
35 S Y=$P($P(";"_Y,";"_PSSCD_":",2),";")
36 Q Y
Note: See TracBrowser for help on using the repository browser.