PSOHLSG5.m

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 ---PSOHLSG5   1313     printed  Apr 09, 2024@21:30:19                                                                                                                                                                                                    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