PSSREMCH.m

PSSREMCH ;BIR/RTR-Pre release Orderable Item report ;02/14/00

 ;;1.0;PHARMACY DATA MANAGEMENT;**34**;9/30/97

 S PSSOUT=0 D TEXT^PSSUTLPR I $G(PSSOUT) K PSSOUT Q

 G ADDRP^PSSUTLPR

ADD ;

 N AAZ,AAZZ,SSZ,SSZZ,PSSATMP,PSSSTMP

 U IO S PSSOUT=0 K PSSADSUM,PSSTOTAL,PSSIVID,PSSIVIDL,PSSSOSUM

 S PSSDV=$S($E(IOST)="C":"C",1:"P"),PSSCOT=1

 S PSSIVID=$S($P($G(^PS(59.7,1,31)),"^",2)'="":$P($G(^(31)),"^",2),1:"IV") S PSSIVIDL=$L(PSSIVID)

 I $G(PSSTYPE)="S" G SOL

 S PSSWH="A"

 N ADD,AA,OI,PAD,ADDIEN,ZERO,LEN,COUNT,PSSAD,PAA,PZZ,PDD,OINAME,OIDOSE,OILT,TOTAL,PSSPADZ,AOILT,NEWOI,NEWOIL,ADDLT,PSSADIN,PSSADID,OIDATE,OIDATED,PSSPADX,PSSPADZZ,OIZD,OIZDZ,PSINDAT,PSINDATE

 K ^TMP($J,"PSSAD")

 D ADDH

 S ADD="" F  S ADD=$O(^PS(52.6,"B",ADD)) Q:ADD=""!($G(PSSOUT))  F ADDIEN=0:0 S ADDIEN=$O(^PS(52.6,"B",ADD,ADDIEN)) Q:'ADDIEN!($G(PSSOUT))  D

 .Q:'$P($G(^PS(52.6,ADDIEN,0)),"^",11)

 .S ZERO=$G(^PS(52.6,ADDIEN,0)),LEN=$L($P(ZERO,"^"))

 .K PSSADID S PSSADIN=$P($G(^PS(52.6,ADDIEN,"I")),"^") I PSSADIN S PSSADID="("_$E(PSSADIN,4,5)_"/"_$E(PSSADIN,6,7)_"/"_$E(PSSADIN,2,3)_")"

 .S LEN=LEN+$S($G(PSSADID)'="":11,1:0)

 .K PAD S $P(PAD,"=",(42-LEN))="",PAD=$G(PAD)_"> "

 .S OINAME=$P($G(^PS(50.7,+$P(ZERO,"^",11),0)),"^"),OIDOSE=$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^"),OILT=$L($G(OINAME))+$L($G(OIDOSE))+2

 .K OIDATED S OIDATE=$P($G(^PS(50.7,+$P(ZERO,"^",11),0)),"^",4) I OIDATE S OIDATED="("_$E(OIDATE,4,5)_"/"_$E(OIDATE,6,7)_"/"_$E(OIDATE,2,3)_")"

 .S ADDLT=$L(ADDIEN)+3

 .S PSSTOTAL=+$G(ADDLT)+45+$G(OILT)+$S($G(OIDATED)'="":11,1:0)+$G(PSSIVIDL)

 .S PSSPADZ=+$G(ADDLT)+42

 .I ($Y+5)>IOSL D ADDH Q:$G(PSSOUT)

 .W !!,?3,"Current Additive/Orderable Item match:",!

 .I $G(PSSTOTAL)<132 W "("_$G(ADDIEN)_") "_$P(ZERO,"^")_$S($G(PSSADID)'="":" "_$G(PSSADID),1:"")_$G(PAD)_$G(OINAME)_"  "_$G(OIDOSE)_$S($G(OIDATED)'="":" "_$G(OIDATED),1:"")_"  "_$G(PSSIVID)

 .I $G(PSSTOTAL)>131 W "("_$G(ADDIEN)_") "_$P(ZERO,"^")_$S($G(PSSADID)'="":" "_$G(PSSADID),1:"")_$G(PAD) W !,"=====> ",$G(OINAME)_"  "_$G(OIDOSE)_$S($G(OIDATED)'="":" "_$G(OIDATED),1:"")_"  "_$G(PSSIVID)

 .S OI=$P($G(^PSDRUG(+$P(ZERO,"^",2),2)),"^") I 'OI W !?5,"cannot re-match, no Orderable Item for the Dispense Drug" Q

 .S PSSATMP=$P($G(^PS(50.7,OI,0)),"^")_"  "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^")

 .S ^TMP($J,"PSSAD",PSSATMP,ADDIEN)=OI

 .S NEWOI=$P($G(^PS(50.7,+$G(OI),0)),"^")_"  "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^")

 .K OIZDZ S OIZD=$P($G(^PS(50.7,+$G(OI),0)),"^",4) I OIZD S OIZDZ="("_$E(OIZD,4,5)_"/"_$E(OIZD,6,7)_"/"_$E(OIZD,2,3)_")"

 .K PSSPADZZ S PSSPADX=$G(PSSPADZ)-18 S $P(PSSPADZZ,"=",PSSPADX)=""

 .S PSSPADZZ=PSSPADZZ_"> "

 .W !,"New Orderable Item"_$G(PSSPADZZ)_$G(NEWOI)_$S($G(OIZDZ)'="":" "_$G(OIZDZ),1:"")

 .W !?2,"Dispense Drugs matched to Orderable Item:"

 .F PAA=0:0 S PAA=$O(^PSDRUG("ASP",OI,PAA)) Q:'PAA!($G(PSSOUT))  D

 ..I ($Y+4)>IOSL D ADDH Q:$G(PSSOUT)

 ..K PSINDATE S PSINDAT=$P($G(^PSDRUG(PAA,"I")),"^") I PSINDAT S PSINDATE=" "_"("_$E(PSINDAT,4,5)_"/"_$E(PSINDAT,6,7)_"/"_$E(PSINDAT,2,3)_")"

 ..I PSINDAT,PSINDAT<$G(PSSYRX) Q

 ..W !?4,$P($G(^PSDRUG(PAA,0)),"^")_$G(PSINDATE) I PAA=$P(ZERO,"^",2) W ?55,"(Additive link)"

 I $G(PSSOUT) G ADDX

 D ADDHS G:$G(PSSOUT) ADDX

 S PSSADSUM=1

 S AA="" F  S AA=$O(^TMP($J,"PSSAD",AA)) Q:AA=""!($G(PSSOUT))  D

 .S AAZ=$O(^TMP($J,"PSSAD",AA,0)),AAZZ=+$G(^TMP($J,"PSSAD",AA,+$G(AAZ)))

 .I ($Y+4)>IOSL D ADDH Q:$G(PSSOUT)

 .W !!,"OI => ",AA_$S($P($G(^PS(50.7,AAZZ,0)),"^",4)="":"",1:" ("_$E($P($G(^(0)),"^",4),4,5)_"/"_$E($P($G(^(0)),"^",4),6,7)_"/"_$E($P($G(^(0)),"^",4),2,3)_")")

 .F PZZ=0:0 S PZZ=$O(^TMP($J,"PSSAD",AA,PZZ)) Q:'PZZ!($G(PSSOUT))  D

 ..I ($Y+4)>IOSL D ADDH Q:$G(PSSOUT)

 ..W !,"("_$G(PZZ)_") ",?13,$P($G(^PS(52.6,PZZ,0)),"^")_$S($P($G(^("I")),"^")="":"",1:" ("_$E($P($G(^("I")),"^"),4,5)_"/"_$E($P($G(^("I")),"^"),6,7)_"/"_$E($P($G(^("I")),"^"),2,3)_")"),?69,"(Additive)"

 .Q:$G(PSSOUT)

 .W !?2,"Dispense Drugs matched to OI:"

 .F PDD=0:0 S PDD=$O(^PSDRUG("ASP",AAZZ,PDD)) Q:'PDD!($G(PSSOUT))  D

 ..I ($Y+4)>IOSL D ADDH Q:$G(PSSOUT)

 ..I $P($G(^PSDRUG(PDD,"I")),"^"),$P($G(^("I")),"^")<$G(PSSYRX) Q

 ..W !,?11,$P($G(^PSDRUG(PDD,0)),"^")_$S($P($G(^("I")),"^")="":"",1:" ("_$E($P($G(^("I")),"^"),4,5)_"/"_$E($P($G(^("I")),"^"),6,7)_"/"_$E($P($G(^("I")),"^"),2,3)_")")

ADDX ;

 K ^TMP($J,"PSSAD")

 I $G(PSSTYPE)="B",'$G(PSSOUT) G SOL

 I '$G(PSSOUT) D PDIR

 G END

SOL ;

 K ^TMP($J,"PSSOL"),PSSCOTX

 S PSSWH="S"

 N SOL,SLDD,SZZ,SOLAA,SAA,SOLIEN,SNAME,SLNEWOI,SOINAME,SOIDOSE,SOILT,SOILTX,STOTAL,SLOI,SDA,SDAT,SDOI,SDOID,SOLLT,PSSSOLZ,SOIZD,SOIZDZ,SZL,SZLA,SLID,SLIDD

 D SOLH S PSSCOTX=1

 I $G(PSSOUT) G SEND

 S SOL="" F  S SOL=$O(^PS(52.7,"B",SOL)) Q:SOL=""!($G(PSSOUT))  F SOLIEN=0:0 S SOLIEN=$O(^PS(52.7,"B",SOL,SOLIEN)) Q:'SOLIEN!($G(PSSOUT))  D

 .Q:'$P($G(^PS(52.7,SOLIEN,0)),"^",11)

 .S ZERO=$G(^PS(52.7,SOLIEN,0))

 .S SNAME=$P(ZERO,"^")_"  ("_$P(ZERO,"^",3)_")",LEN=$L(SNAME)

 .K SDAT S SDA=$P($G(^PS(52.7,SOLIEN,"I")),"^") I SDA S SDAT="("_$E(SDA,4,5)_"/"_$E(SDA,6,7)_"/"_$E(SDA,2,3)_")"

 .S LEN=LEN+$S($G(SDAT)'="":11,1:0)

 .K PAD S $P(PAD,"=",(53-LEN))="",PAD=$G(PAD)_"> "

 .S SOINAME=$P($G(^PS(50.7,+$P(ZERO,"^",11),0)),"^"),SOIDOSE=$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^"),SOILT=$L($G(SOINAME))+$L($G(SOIDOSE))+2

 .K SDOID S SDOI=$P($G(^PS(50.7,+$P(ZERO,"^",11),0)),"^",4) I SDOI S SDOID="("_$E(SDOI,4,5)_"/"_$E(SDOI,6,7)_"/"_$E(SDOI,2,3)_")"

 .S SOLLT=$L(SOLIEN)+3

 .S PSSTOTAL=+$G(SOLLT)+67+$G(SOILT)+$S($G(PDOID)'="":11,1:0)+$G(PSSIVIDL)

 .S PSSSOLZ=+$G(SOLLT)+53

 .I ($Y+5)>IOSL D SOLH Q:$G(PSSOUT)

 .W !!?3,"Current Solution/Orderable Item match:",!

 .I $G(PSSTOTAL)<132 W "("_$G(SOLIEN)_") "_$G(SNAME)_$S($G(SDAT)'="":" "_$G(SDAT),1:"")_$G(PAD)_$G(SOINAME)_"  "_$G(SOIDOSE)_$S($G(SDOID)'="":" "_$G(SDOID),1:"")_"  "_$G(PSSIVID)

 .I $G(PSSTOTAL)>131 W "("_$G(SOLIEN)_") "_$G(SNAME)_$S($G(SDAT)'="":" "_$G(SDAT),1:"")_$G(PAD) D:($Y+4)>IOSL SOLH Q:$G(PSSOUT)  W !,"=====> ",$G(SOINAME)_"  "_$G(SOIDOSE)_$S($G(SDOID)'="":" "_$G(SDOID),1:"")_"  "_$G(PSSIVID)

 .S SLOI=$P($G(^PSDRUG(+$P(ZERO,"^",2),2)),"^") I 'SLOI W !?5,"cannot rematch, no Item for the Dispense Drug" Q

 .S PSSSTMP=$P($G(^PS(50.7,+$G(SLOI),0)),"^")_"  "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^")

 .S ^TMP($J,"PSSOL",PSSSTMP,SOLIEN)=SLOI

 .S SLNEWOI=$P($G(^PS(50.7,+$G(SLOI),0)),"^")_"  "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^")

 .K SOIZDZ S SOIZD=$P($G(^PS(50.7,+$G(SLOI),0)),"^",4) I SOIZD S SOIZDZ="("_$E(SOIZD,4,5)_"/"_$E(SOIZD,6,7)_"/"_$E(SOIZD,2,3)_")"

 .K SZL S SZLA=$G(PSSSOLZ)-18 S $P(SZL,"=",SZLA)="" S SZL=SZL_"> "

 .W !,"New Orderable Item"_$G(SZL)_$G(SLNEWOI)_$S($G(SOIZDZ)'="":" "_$G(SOIZDZ),1:"")

 .W !?2,"Dispense Drugs matched to Orderable Item:"

 .F SAA=0:0 S SAA=$O(^PSDRUG("ASP",SLOI,SAA)) Q:'SAA!($G(PSSOUT))  D

 ..I ($Y+4)>IOSL D SOLH Q:$G(PSSOUT)

 ..K SLID S SLIDD=$P($G(^PSDRUG(SAA,"I")),"^") I SLIDD S SLID=" "_"("_$E(SLIDD,4,5)_"/"_$E(SLIDD,6,7)_"/"_$E(SLIDD,2,3)_")"

 ..I SLIDD,SLIDD<$G(PSSYRX) Q

 ..W !?4,$P($G(^PSDRUG(SAA,0)),"^")_$G(SLID) I SAA=$P(ZERO,"^",2) W ?59,"(Solution link)"

 I $G(PSSOUT) G SEND

 D SOLHS G:$G(PSSOUT) SEND

 S PSSSOSUM=1

 S SOLAA="" F  S SOLAA=$O(^TMP($J,"PSSOL",SOLAA)) Q:SOLAA=""!($G(PSSOUT))  D

 .S SSZ=$O(^TMP($J,"PSSOL",SOLAA,0)),SSZZ=+$G(^TMP($J,"PSSOL",SOLAA,+$G(SSZ)))

 .I ($Y+4)>IOSL D SOLH Q:$G(PSSOUT)

 .W !!,"OI => ",SOLAA_$S($P($G(^PS(50.7,SSZZ,0)),"^",4)="":"",1:" ("_$E($P($G(^(0)),"^",4),4,5)_"/"_$E($P($G(^(0)),"^",4),6,7)_"/"_$E($P($G(^(0)),"^",4),2,3)_")")

 .F SZZ=0:0 S SZZ=$O(^TMP($J,"PSSOL",SOLAA,SZZ)) Q:'SZZ!($G(PSSOUT))  D

 ..I ($Y+4)>IOSL D SOLH Q:$G(PSSOUT)

 ..W !,"("_$G(SZZ)_") ",?13,$P($G(^PS(52.7,SZZ,0)),"^")_"   ("_$P($G(^(0)),"^",3)_")"_$S($P($G(^("I")),"^")="":"",1:" ("_$E($P($G(^("I")),"^"),4,5)_"/"_$E($P($G(^("I")),"^"),6,7)_"/"_$E($P($G(^("I")),"^"),2,3)_")") W ?67,"(Solution)"

 .Q:$G(PSSOUT)

 .W !?2,"Dispense Drugs matched to OI:"

 .F SLDD=0:0 S SLDD=$O(^PSDRUG("ASP",SSZZ,SLDD)) Q:'SLDD!($G(PSSOUT))  D

 ..I ($Y+4)>IOSL D SOLH Q:$G(PSSOUT)

 ..I $P($G(^PSDRUG(SLDD,"I")),"^"),$P($G(^("I")),"^")<$G(PSSYRX) Q

 ..W !?11,$P($G(^PSDRUG(SLDD,0)),"^")_$S($P($G(^("I")),"^")="":"",1:" ("_$E($P($G(^("I")),"^"),4,5)_"/"_$E($P($G(^("I")),"^"),6,7)_"/"_$E($P($G(^("I")),"^"),2,3)_")")

 I '$G(PSSOUT) D PDIR

SEND ;

 K ^TMP($J,"PSSOL")

END I $G(PSSDV)="C" W !

 E  W @IOF

 K PSSTOTAL,PSSIVID,PSSIVIDL,PSSTYPE,PSSDV,PSSWH,PSSCOT,PSSOUT,PSSCOTX,PSSADSUM,PSSSOSUM,PSSYRX

 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q

ADDH ;

 I $G(PSSCOT)=1 W @IOF W !?5,"ADDITIVE REPORT    (Additive Internal number in parenthesis)",?67,"PAGE: "_$G(PSSCOT) S PSSCOT=PSSCOT+1 Q

 I $G(PSSDV)="C" K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSOUT=1 Q

 W @IOF W !?8,"ADDITIVE "_$S('$G(PSSADSUM):"REPORT",1:"SUMMARY")_"   (continued)" W ?67,"PAGE: "_$G(PSSCOT) S PSSCOT=PSSCOT+1

 Q

ADDHS ;

 I $G(PSSDV)="C" K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit"  D ^DIR K DIR I 'Y S PSSOUT=1 Q

 W @IOF W !!?5,"ADDITIVE SUMMARY" W ?67,"PAGE: "_$G(PSSCOT) S PSSCOT=PSSCOT+1

 Q

SOLH ;

 I '$G(PSSCOTX) D  Q:$G(PSSOUT)  W @IOF W !?5,"SOLUTION REPORT   (Solution Internal number in parenthesis)",?67,"PAGE: "_$G(PSSCOT) S PSSCOT=PSSCOT+1 Q

 .I $G(PSSDV)="C",$G(PSSCOT)'=1 K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSOUT=1

 I $G(PSSDV)="C" K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSOUT=1 Q

 W @IOF W !?8,"SOLUTION "_$S('$G(PSSSOSUM):"REPORT",1:"SUMMARY")_"   (continued)" W ?67,"PAGE: "_$G(PSSCOT) S PSSCOT=PSSCOT+1

 Q

SOLHS ;

 I $G(PSSDV)="C" K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSOUT=1 Q

 W @IOF W !!?5,"SOLUTION SUMMARY" W ?67,"PAGE: "_$G(PSSCOT) S PSSCOT=PSSCOT+1

 Q

PDIR ;

 Q:$G(PSSDV)'="C"

 W ! S DIR(0)="E",DIR("A")="Pres Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSOUT=1

 Q

PSSREMCH  ;BIR/RTR-Pre release Orderable Item report ;02/14/00

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**34**;9/30/97

 +2        SET PSSOUT=0

           DO TEXT^PSSUTLPR

           IF $GET(PSSOUT)

               KILL PSSOUT

               QUIT 

 +3        GOTO ADDRP^PSSUTLPR

ADD       ;

 +1        NEW AAZ,AAZZ,SSZ,SSZZ,PSSATMP,PSSSTMP

 +2        USE IO

           SET PSSOUT=0

           KILL PSSADSUM,PSSTOTAL,PSSIVID,PSSIVIDL,PSSSOSUM

 +3        SET PSSDV=$SELECT($EXTRACT(IOST)="C":"C",1:"P")

           SET PSSCOT=1

 +4        SET PSSIVID=$SELECT($PIECE($GET(^PS(59.7,1,31)),"^",2)'="":$PIECE($GET(^(31)),"^",2),1:"IV")

           SET PSSIVIDL=$LENGTH(PSSIVID)

 +5        IF $GET(PSSTYPE)="S"

               GOTO SOL

 +6        SET PSSWH="A"

 +7        NEW ADD,AA,OI,PAD,ADDIEN,ZERO,LEN,COUNT,PSSAD,PAA,PZZ,PDD,OINAME,OIDOSE,OILT,TOTAL,PSSPADZ,AOILT,NEWOI,NEWOIL,ADDLT,PSSADIN,PSSADID,OIDATE,OIDATED,PSSPADX,PSSPADZZ,OIZD,OIZDZ,PSINDAT,PSINDATE

 +8        KILL ^TMP($JOB,"PSSAD")

 +9        DO ADDH

 +10       SET ADD=""

           FOR 

               SET ADD=$ORDER(^PS(52.6,"B",ADD))

               IF ADD=""!($GET(PSSOUT))

                   QUIT 

               FOR ADDIEN=0:0

                   SET ADDIEN=$ORDER(^PS(52.6,"B",ADD,ADDIEN))

                   IF 'ADDIEN!($GET(PSSOUT))

                       QUIT 

                   Begin DoDot:1

 +11                   IF '$PIECE($GET(^PS(52.6,ADDIEN,0)),"^",11)

                           QUIT 

 +12                   SET ZERO=$GET(^PS(52.6,ADDIEN,0))

                       SET LEN=$LENGTH($PIECE(ZERO,"^"))

 +13                   KILL PSSADID

                       SET PSSADIN=$PIECE($GET(^PS(52.6,ADDIEN,"I")),"^")

                       IF PSSADIN

                           SET PSSADID="("_$EXTRACT(PSSADIN,4,5)_"/"_$EXTRACT(PSSADIN,6,7)_"/"_$EXTRACT(PSSADIN,2,3)_")"

 +14                   SET LEN=LEN+$SELECT($GET(PSSADID)'="":11,1:0)

 +15                   KILL PAD

                       SET $PIECE(PAD,"=",(42-LEN))=""

                       SET PAD=$GET(PAD)_"> "

 +16                   SET OINAME=$PIECE($GET(^PS(50.7,+$PIECE(ZERO,"^",11),0)),"^")

                       SET OIDOSE=$PIECE($GET(^PS(50.606,+$PIECE($GET(^(0)),"^",2),0)),"^")

                       SET OILT=$LENGTH($GET(OINAME))+$LENGTH($GET(OIDOSE))+2

 +17                   KILL OIDATED

                       SET OIDATE=$PIECE($GET(^PS(50.7,+$PIECE(ZERO,"^",11),0)),"^",4)

                       IF OIDATE

                           SET OIDATED="("_$EXTRACT(OIDATE,4,5)_"/"_$EXTRACT(OIDATE,6,7)_"/"_$EXTRACT(OIDATE,2,3)_")"

 +18                   SET ADDLT=$LENGTH(ADDIEN)+3

 +19                   SET PSSTOTAL=+$GET(ADDLT)+45+$GET(OILT)+$SELECT($GET(OIDATED)'="":11,1:0)+$GET(PSSIVIDL)

 +20                   SET PSSPADZ=+$GET(ADDLT)+42

 +21                   IF ($Y+5)>IOSL

                           DO ADDH

                           IF $GET(PSSOUT)

                               QUIT 

 +22                   WRITE !!,?3,"Current Additive/Orderable Item match:",!

 +23                   IF $GET(PSSTOTAL)<132

                           WRITE "("_$GET(ADDIEN)_") "_$PIECE(ZERO,"^")_$SELECT($GET(PSSADID)'="":" "_$GET(PSSADID),1:"")_$GET(PAD)_$GET(OINAME)_"  "_$GET(OIDOSE)_$SELECT($GET(OIDATED)'="":" "_$GET(OIDATED),1:"")_"  "_$GET(PSSIVID)

 +24                   IF $GET(PSSTOTAL)>131

                           WRITE "("_$GET(ADDIEN)_") "_$PIECE(ZERO,"^")_$SELECT($GET(PSSADID)'="":" "_$GET(PSSADID),1:"")_$GET(PAD)

                           WRITE !,"=====> ",$GET(OINAME)_"  "_$GET(OIDOSE)_$SELECT($GET(OIDATED)'="":" "_$GET(OIDATED),1:"")_"  "_$GET(PSSIVID)

 +25                   SET OI=$PIECE($GET(^PSDRUG(+$PIECE(ZERO,"^",2),2)),"^")

                       IF 'OI

                           WRITE !?5,"cannot re-match, no Orderable Item for the Dispense Drug"

                           QUIT 

 +26                   SET PSSATMP=$PIECE($GET(^PS(50.7,OI,0)),"^")_"  "_$PIECE($GET(^PS(50.606,+$PIECE($GET(^(0)),"^",2),0)),"^")

 +27                   SET ^TMP($JOB,"PSSAD",PSSATMP,ADDIEN)=OI

 +28                   SET NEWOI=$PIECE($GET(^PS(50.7,+$GET(OI),0)),"^")_"  "_$PIECE($GET(^PS(50.606,+$PIECE($GET(^(0)),"^",2),0)),"^")

 +29                   KILL OIZDZ

                       SET OIZD=$PIECE($GET(^PS(50.7,+$GET(OI),0)),"^",4)

                       IF OIZD

                           SET OIZDZ="("_$EXTRACT(OIZD,4,5)_"/"_$EXTRACT(OIZD,6,7)_"/"_$EXTRACT(OIZD,2,3)_")"

 +30                   KILL PSSPADZZ

                       SET PSSPADX=$GET(PSSPADZ)-18

                       SET $PIECE(PSSPADZZ,"=",PSSPADX)=""

 +31                   SET PSSPADZZ=PSSPADZZ_"> "

 +32                   WRITE !,"New Orderable Item"_$GET(PSSPADZZ)_$GET(NEWOI)_$SELECT($GET(OIZDZ)'="":" "_$GET(OIZDZ),1:"")

 +33                   WRITE !?2,"Dispense Drugs matched to Orderable Item:"

 +34                   FOR PAA=0:0

                           SET PAA=$ORDER(^PSDRUG("ASP",OI,PAA))

                           IF 'PAA!($GET(PSSOUT))

                               QUIT 

                           Begin DoDot:2

 +35                           IF ($Y+4)>IOSL

                                   DO ADDH

                                   IF $GET(PSSOUT)

                                       QUIT 

 +36                           KILL PSINDATE

                               SET PSINDAT=$PIECE($GET(^PSDRUG(PAA,"I")),"^")

                               IF PSINDAT

                                   SET PSINDATE=" "_"("_$EXTRACT(PSINDAT,4,5)_"/"_$EXTRACT(PSINDAT,6,7)_"/"_$EXTRACT(PSINDAT,2,3)_")"

 +37                           IF PSINDAT

                                   IF PSINDAT<$GET(PSSYRX)

                                       QUIT 

 +38                           WRITE !?4,$PIECE($GET(^PSDRUG(PAA,0)),"^")_$GET(PSINDATE)

                               IF PAA=$PIECE(ZERO,"^",2)

                                   WRITE ?55,"(Additive link)"

                           End DoDot:2

                   End DoDot:1

 +39       IF $GET(PSSOUT)

               GOTO ADDX

 +40       DO ADDHS

           IF $GET(PSSOUT)

               GOTO ADDX

 +41       SET PSSADSUM=1

 +42       SET AA=""

           FOR 

               SET AA=$ORDER(^TMP($JOB,"PSSAD",AA))

               IF AA=""!($GET(PSSOUT))

                   QUIT 

               Begin DoDot:1

 +43               SET AAZ=$ORDER(^TMP($JOB,"PSSAD",AA,0))

                   SET AAZZ=+$GET(^TMP($JOB,"PSSAD",AA,+$GET(AAZ)))

 +44               IF ($Y+4)>IOSL

                       DO ADDH

                       IF $GET(PSSOUT)

                           QUIT 

 +45               WRITE !!,"OI => ",AA_$SELECT($PIECE($GET(^PS(50.7,AAZZ,0)),"^",4)="":"",1:" ("_$EXTRACT($PIECE($GET(^(0)),"^",4),4,5)_"/"_$EXTRACT($PIECE($GET(^(0)),"^",4),6,7)_"/"_$EXTRACT($PIECE($GET(^(0)),"^",4),2,3)_")")

 +46               FOR PZZ=0:0

                       SET PZZ=$ORDER(^TMP($JOB,"PSSAD",AA,PZZ))

                       IF 'PZZ!($GET(PSSOUT))

                           QUIT 

                       Begin DoDot:2

 +47                       IF ($Y+4)>IOSL

                               DO ADDH

                               IF $GET(PSSOUT)

                                   QUIT 

 +48                      WRITE !,"("_$GET(PZZ)_") ",?13,$PIECE($GET(^PS(52.6,PZZ,0)),"^")_$SELECT($PIECE($GET(^("I")),"^")="":"",1:" ("_$EXTRACT($PIECE($GET(^("I")),"^"),4,5)_"/"_$EXTRACT($PIECE($GET(^("I")),"^"),6,7)_"/"_$EXTRACT($PIECE(...

                           ... $GET(^("I")),"^"),2,3)_")"),?69,"(Additive)"

                       End DoDot:2

 +49               IF $GET(PSSOUT)

                       QUIT 

 +50               WRITE !?2,"Dispense Drugs matched to OI:"

 +51               FOR PDD=0:0

                       SET PDD=$ORDER(^PSDRUG("ASP",AAZZ,PDD))

                       IF 'PDD!($GET(PSSOUT))

                           QUIT 

                       Begin DoDot:2

 +52                       IF ($Y+4)>IOSL

                               DO ADDH

                               IF $GET(PSSOUT)

                                   QUIT 

 +53                       IF $PIECE($GET(^PSDRUG(PDD,"I")),"^")

                               IF $PIECE($GET(^("I")),"^")<$GET(PSSYRX)

                                   QUIT 

 +54                       WRITE !,?11,$PIECE($GET(^PSDRUG(PDD,0)),"^")_$SELECT($PIECE($GET(^("I")),"^")="":"",1:" ("_$EXTRACT($PIECE($GET(^("I")),"^"),4,5)_"/"_$EXTRACT($PIECE($GET(^("I")),"^"),6,7)_"/"_$EXTRACT($PIECE($GET(^("I")),"^"),2,3)_")")

                       End DoDot:2

               End DoDot:1

ADDX      ;

 +1        KILL ^TMP($JOB,"PSSAD")

 +2        IF $GET(PSSTYPE)="B"

               IF '$GET(PSSOUT)

                   GOTO SOL

 +3        IF '$GET(PSSOUT)

               DO PDIR

 +4        GOTO END

SOL       ;

 +1        KILL ^TMP($JOB,"PSSOL"),PSSCOTX

 +2        SET PSSWH="S"

 +3        NEW SOL,SLDD,SZZ,SOLAA,SAA,SOLIEN,SNAME,SLNEWOI,SOINAME,SOIDOSE,SOILT,SOILTX,STOTAL,SLOI,SDA,SDAT,SDOI,SDOID,SOLLT,PSSSOLZ,SOIZD,SOIZDZ,SZL,SZLA,SLID,SLIDD

 +4        DO SOLH

           SET PSSCOTX=1

 +5        IF $GET(PSSOUT)

               GOTO SEND

 +6        SET SOL=""

           FOR 

               SET SOL=$ORDER(^PS(52.7,"B",SOL))

               IF SOL=""!($GET(PSSOUT))

                   QUIT 

               FOR SOLIEN=0:0

                   SET SOLIEN=$ORDER(^PS(52.7,"B",SOL,SOLIEN))

                   IF 'SOLIEN!($GET(PSSOUT))

                       QUIT 

                   Begin DoDot:1

 +7                    IF '$PIECE($GET(^PS(52.7,SOLIEN,0)),"^",11)

                           QUIT 

 +8                    SET ZERO=$GET(^PS(52.7,SOLIEN,0))

 +9                    SET SNAME=$PIECE(ZERO,"^")_"  ("_$PIECE(ZERO,"^",3)_")"

                       SET LEN=$LENGTH(SNAME)

 +10                   KILL SDAT

                       SET SDA=$PIECE($GET(^PS(52.7,SOLIEN,"I")),"^")

                       IF SDA

                           SET SDAT="("_$EXTRACT(SDA,4,5)_"/"_$EXTRACT(SDA,6,7)_"/"_$EXTRACT(SDA,2,3)_")"

 +11                   SET LEN=LEN+$SELECT($GET(SDAT)'="":11,1:0)

 +12                   KILL PAD

                       SET $PIECE(PAD,"=",(53-LEN))=""

                       SET PAD=$GET(PAD)_"> "

 +13                   SET SOINAME=$PIECE($GET(^PS(50.7,+$PIECE(ZERO,"^",11),0)),"^")

                       SET SOIDOSE=$PIECE($GET(^PS(50.606,+$PIECE($GET(^(0)),"^",2),0)),"^")

                       SET SOILT=$LENGTH($GET(SOINAME))+$LENGTH($GET(SOIDOSE))+2

 +14                   KILL SDOID

                       SET SDOI=$PIECE($GET(^PS(50.7,+$PIECE(ZERO,"^",11),0)),"^",4)

                       IF SDOI

                           SET SDOID="("_$EXTRACT(SDOI,4,5)_"/"_$EXTRACT(SDOI,6,7)_"/"_$EXTRACT(SDOI,2,3)_")"

 +15                   SET SOLLT=$LENGTH(SOLIEN)+3

 +16                   SET PSSTOTAL=+$GET(SOLLT)+67+$GET(SOILT)+$SELECT($GET(PDOID)'="":11,1:0)+$GET(PSSIVIDL)

 +17                   SET PSSSOLZ=+$GET(SOLLT)+53

 +18                   IF ($Y+5)>IOSL

                           DO SOLH

                           IF $GET(PSSOUT)

                               QUIT 

 +19                   WRITE !!?3,"Current Solution/Orderable Item match:",!

 +20                   IF $GET(PSSTOTAL)<132

                           WRITE "("_$GET(SOLIEN)_") "_$GET(SNAME)_$SELECT($GET(SDAT)'="":" "_$GET(SDAT),1:"")_$GET(PAD)_$GET(SOINAME)_"  "_$GET(SOIDOSE)_$SELECT($GET(SDOID)'="":" "_$GET(SDOID),1:"")_"  "_$GET(PSSIVID)