PSOHLSG5 ;BIR/SJA,PWC-Logical Links derive ;08/13/01 13:46
;;7.0;OUTPATIENT PHARMACY;**70,156**;DEC 1997
;Reference to ^SC( is supported by DBIA #10040
;Reference to ^DG(40.8 is supported by DBIA #1576
;Reference to ^HLCS(870 is supported by DBIA #1496
;
STRT N PSONODE,PSOLL,INPTRX,NN,PSOCOI,II,CLIN,PSOS,PSRX,PXIEN,PSODISP
S II=0 F S II=$O(^UTILITY($J,"PSOHLL",II)) Q:'II S PSONODE=$G(^(II)) D
.S PXIEN=$P(PSONODE,"^"),CLIN=$P($G(^PSRX(PXIEN,0)),"^",5)
.S PSODISP=$$GET1^DIQ(59,PSOSITE_",",105,"I")
.I CLIN D OI
.I 'CLIN!($G(PSOLL)="") D LL2
.I $G(PSOLL)="" S PSOLL="PSO LLP1"
.I $G(PSODISP)=2.4 S PSOLL="PSO DISP" ;dispensing machine using V.2.4
.S $P(^UTILITY($J,"PSOHLL",II),"^",11)=CLIN_"^"_PSOLL
Q
OI S PSOCOI="" S:'$D(^SC(CLIN,0)) CLIN=""
S INPTRX=0 I $G(CLIN) S PSOCOI=$P($G(^SC(CLIN,0)),"^",4)
I '$G(PSOCOI) D
.I $G(CLIN) S INPTRX=$P($G(^SC(CLIN,0)),"^",15)
.I '$G(INPTRX) S INPTRX=$O(^DG(40.8,0))
.I '$G(DT) S DT=$$DT^XLFDT
.S PSOCOI=+$$SITE^VASITE(DT,INPTRX)
LL1 S NN=0 F S NN=$O(^PS(59,PSOSITE,"INI1",NN)) Q:'NN!($G(PSOLL)) S PSOS=$G(^(NN,0)) I $P(PSOS,"^")=PSOCOI S PSOLL=$$GET1^DIQ(870,+$P(PSOS,"^",2),.01)
Q
LL2 ;Derive the LOCICAL LINK from the top level LL field.
S PSOLL=$P($G(^PS(59,PSOSITE,8)),"^",4),PSOLL=$$GET1^DIQ(870,+PSOLL,.01)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOHLSG5 1313 printed Dec 13, 2024@02:30:08 Page 2
PSOHLSG5 ;BIR/SJA,PWC-Logical Links derive ;08/13/01 13:46
+1 ;;7.0;OUTPATIENT PHARMACY;**70,156**;DEC 1997
+2 ;Reference to ^SC( is supported by DBIA #10040
+3 ;Reference to ^DG(40.8 is supported by DBIA #1576
+4 ;Reference to ^HLCS(870 is supported by DBIA #1496
+5 ;
STRT NEW PSONODE,PSOLL,INPTRX,NN,PSOCOI,II,CLIN,PSOS,PSRX,PXIEN,PSODISP
+1 SET II=0
FOR
SET II=$ORDER(^UTILITY($JOB,"PSOHLL",II))
if 'II
QUIT
SET PSONODE=$GET(^(II))
Begin DoDot:1
+2 SET PXIEN=$PIECE(PSONODE,"^")
SET CLIN=$PIECE($GET(^PSRX(PXIEN,0)),"^",5)
+3 SET PSODISP=$$GET1^DIQ(59,PSOSITE_",",105,"I")
+4 IF CLIN
DO OI
+5 IF 'CLIN!($GET(PSOLL)="")
DO LL2
+6 IF $GET(PSOLL)=""
SET PSOLL="PSO LLP1"
+7 ;dispensing machine using V.2.4
IF $GET(PSODISP)=2.4
SET PSOLL="PSO DISP"
+8 SET $PIECE(^UTILITY($JOB,"PSOHLL",II),"^",11)=CLIN_"^"_PSOLL
End DoDot:1
+9 QUIT
OI SET PSOCOI=""
if '$DATA(^SC(CLIN,0))
SET CLIN=""
+1 SET INPTRX=0
IF $GET(CLIN)
SET PSOCOI=$PIECE($GET(^SC(CLIN,0)),"^",4)
+2 IF '$GET(PSOCOI)
Begin DoDot:1
+3 IF $GET(CLIN)
SET INPTRX=$PIECE($GET(^SC(CLIN,0)),"^",15)
+4 IF '$GET(INPTRX)
SET INPTRX=$ORDER(^DG(40.8,0))
+5 IF '$GET(DT)
SET DT=$$DT^XLFDT
+6 SET PSOCOI=+$$SITE^VASITE(DT,INPTRX)
End DoDot:1
LL1 SET NN=0
FOR
SET NN=$ORDER(^PS(59,PSOSITE,"INI1",NN))
if 'NN!($GET(PSOLL))
QUIT
SET PSOS=$GET(^(NN,0))
IF $PIECE(PSOS,"^")=PSOCOI
SET PSOLL=$$GET1^DIQ(870,+$PIECE(PSOS,"^",2),.01)
+1 QUIT
LL2 ;Derive the LOCICAL LINK from the top level LL field.
+1 SET PSOLL=$PIECE($GET(^PS(59,PSOSITE,8)),"^",4)
SET PSOLL=$$GET1^DIQ(870,+PSOLL,.01)
+2 QUIT
