PSSQORD ;BIR/RTR-POE Quick Order Conversion ;08/21/00
;;1.0;PHARMACY DATA MANAGEMENT;**38**;9/30/97
;S X=$$EN^PSSQORD(V1,V2)
;V1=Orderable Item of Quick Order
;V2=Dispense Drug of the Quick Order
;If we get V2, we get current OI, and return
; piece 1 is returned as IEN from 50.7
; piece 2 is 1 if active
; piece 2 is 0 if inactive
; piece 3 is the inactive date, only if piece 2 is 0
EN(PSS1,PSS2) ;
N PSSNW,PSSNEWIT,PSSDT,PSSLA,PSSLS,PSSOFLAG,PSSDR
I '$G(PSS1),'$G(PSS2) Q -1
I $G(PSS2) S PSSNEWIT=+$P($G(^PSDRUG(PSS2,2)),"^") G AC
I '$D(^PS(50.7,+$G(PSS1),0)) Q -1
I '$P($G(^PS(50.7,+$G(PSS1),0)),"^",3) S PSSNEWIT=$G(PSS1) G AC
S (PSSNW,PSSOFLAG)=0
F PSSLS=0:0 S PSSLS=$O(^XTMP("PSSCONS",PSS1,PSSLS)) Q:'PSSLS!($G(PSSOFLAG)) D
.I 'PSSNW S PSSNW=$P($G(^XTMP("PSSCONS",PSS1,PSSLS)),"^") Q
.I PSSNW,PSSNW'=$P($G(^XTMP("PSSCONS",PSS1,PSSLS)),"^") S PSSOFLAG=1
I $G(PSSOFLAG) Q -1
F PSSLA=0:0 S PSSLA=$O(^XTMP("PSSCONA",PSS1,PSSLA)) Q:'PSSLA!($G(PSSOFLAG)) D
.I 'PSSNW S PSSNW=$P($G(^XTMP("PSSCONA",PSS1,PSSLA)),"^") Q
.I PSSNW,PSSNW'=$P($G(^XTMP("PSSCONA",PSS1,PSSLA)),"^") S PSSOFLAG=1
I $G(PSSOFLAG) Q -1
I '$G(PSSNW) Q -1
S PSSNEWIT=$G(PSSNW)
AC ;
I '$G(PSSNEWIT) Q -1
I '$D(^PS(50.7,PSSNEWIT,0)) Q -1
S PSSDT=$P($G(^PS(50.7,PSSNEWIT,0)),"^",4)
I PSSDT Q PSSNEWIT_"^0^"_PSSDT
Q PSSNEWIT_"^"_1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSQORD 1361 printed Nov 22, 2024@17:44:17 Page 2
PSSQORD ;BIR/RTR-POE Quick Order Conversion ;08/21/00
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**38**;9/30/97
+2 ;S X=$$EN^PSSQORD(V1,V2)
+3 ;V1=Orderable Item of Quick Order
+4 ;V2=Dispense Drug of the Quick Order
+5 ;If we get V2, we get current OI, and return
+6 ; piece 1 is returned as IEN from 50.7
+7 ; piece 2 is 1 if active
+8 ; piece 2 is 0 if inactive
+9 ; piece 3 is the inactive date, only if piece 2 is 0
EN(PSS1,PSS2) ;
+1 NEW PSSNW,PSSNEWIT,PSSDT,PSSLA,PSSLS,PSSOFLAG,PSSDR
+2 IF '$GET(PSS1)
IF '$GET(PSS2)
QUIT -1
+3 IF $GET(PSS2)
SET PSSNEWIT=+$PIECE($GET(^PSDRUG(PSS2,2)),"^")
GOTO AC
+4 IF '$DATA(^PS(50.7,+$GET(PSS1),0))
QUIT -1
+5 IF '$PIECE($GET(^PS(50.7,+$GET(PSS1),0)),"^",3)
SET PSSNEWIT=$GET(PSS1)
GOTO AC
+6 SET (PSSNW,PSSOFLAG)=0
+7 FOR PSSLS=0:0
SET PSSLS=$ORDER(^XTMP("PSSCONS",PSS1,PSSLS))
if 'PSSLS!($GET(PSSOFLAG))
QUIT
Begin DoDot:1
+8 IF 'PSSNW
SET PSSNW=$PIECE($GET(^XTMP("PSSCONS",PSS1,PSSLS)),"^")
QUIT
+9 IF PSSNW
IF PSSNW'=$PIECE($GET(^XTMP("PSSCONS",PSS1,PSSLS)),"^")
SET PSSOFLAG=1
End DoDot:1
+10 IF $GET(PSSOFLAG)
QUIT -1
+11 FOR PSSLA=0:0
SET PSSLA=$ORDER(^XTMP("PSSCONA",PSS1,PSSLA))
if 'PSSLA!($GET(PSSOFLAG))
QUIT
Begin DoDot:1
+12 IF 'PSSNW
SET PSSNW=$PIECE($GET(^XTMP("PSSCONA",PSS1,PSSLA)),"^")
QUIT
+13 IF PSSNW
IF PSSNW'=$PIECE($GET(^XTMP("PSSCONA",PSS1,PSSLA)),"^")
SET PSSOFLAG=1
End DoDot:1
+14 IF $GET(PSSOFLAG)
QUIT -1
+15 IF '$GET(PSSNW)
QUIT -1
+16 SET PSSNEWIT=$GET(PSSNW)
AC ;
+1 IF '$GET(PSSNEWIT)
QUIT -1
+2 IF '$DATA(^PS(50.7,PSSNEWIT,0))
QUIT -1
+3 SET PSSDT=$PIECE($GET(^PS(50.7,PSSNEWIT,0)),"^",4)
+4 IF PSSDT
QUIT PSSNEWIT_"^0^"_PSSDT
+5 QUIT PSSNEWIT_"^"_1
