PSALFS.m

PSALFS ;BIR/LTL-Report Potential FSN Matches ;7/23/97

 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15**; 10/24/97

 ;

 ;References to ^PSDRUG( are covered by IA #2095

 ;References to ^PRC( are covered by IA #214

 ;References to ^PSDRUG("AB" are covered by IA #2095

 ;

 D DT^DICRW

DEV ;asks device and queueing info

 K IO("Q") N %ZIS,DTOUT,DUOUT,IOP,POP,PSAOUT S %ZIS="Q" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" S PSAOUT=1 G QUIT

 I $D(IO("Q")) N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK S ZTRTN="START^PSALFS",ZTDESC="Unlinked DRUG/ITEM FILE matches by FSN" D ^%ZTLOAD,HOME^%ZIS S PSAOUT=1 G QUIT

START ;compiles and prints data for report

 N DIR,DIRUT,PSAPG,POP,PSA,PSAD,PSADD,PSAF,PSAFSN,PSAIT,PSALN,PSARPDT,X,Y S (PSA,PSAD,PSAPG,PSAOUT)=0,Y=DT D DD^%DT S PSARPDT=Y D HEADER

LOOP F  S PSAD=$O(^PSDRUG(PSAD)) G:'PSAD QUIT D:$Y+4>IOSL HEADER G:PSAOUT QUIT I $P($G(^PSDRUG(PSAD,0)),U,6)]"",'$O(^PSDRUG(PSAD,441,0)),'$D(^PSDRUG(PSAD,"I")) D

 .W !!,$P($G(^PSDRUG(+PSAD,0)),U),!

FORM .S PSAFSN=$P(^PSDRUG(PSAD,0),U,6) W !,PSAFSN S PSAIT=$O(^PRC(441,"BB",PSAFSN,0)) W:'PSAIT ?40,"No matching NSN in ITEM MASTER file" Q:'PSAIT  D

 ..D

USED ...I $O(^PSDRUG("AB",PSAIT,"")) S PSADD=$O(^PSDRUG("AB",PSAIT,"")) W !,"**"_$P(^PSDRUG(PSADD,0),U)_" is already linked to Item #"_PSAIT_"**"

 ...W ?40,"ITEM Number:  "_PSAIT,!

 ..I $L($G(^PRC(441,+PSAIT,1,1,0)))<40,'$O(^PRC(441,+PSAIT,1,1)) W ?40,$G(^PRC(441,+PSAIT,1,1,0)),! Q

 ..K ^UTILITY($J,"W") S DIWL=40,DIWR=80,DIWF="W"

 ..F  S PSA=$O(^PRC(441,+PSAIT,1,PSA)) Q:'PSA  S X=$G(^PRC(441,+PSAIT,1,PSA,0)) D ^DIWP

 ..D ^DIWW S PSA=0

QUIT I $E(IOST)'="C" W @IOF

 I $E(IOST,1,2)="C-",'$G(PSAOUT) W !! S DIR(0)="EA",DIR("A")="END OF REPORT!  Press <RET> to return to the menu." D ^DIR

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

 Q

HEADER ;prints header info

 I $E(IOST,1,2)'="P-",PSAPG S DIR(0)="E" D ^DIR K DIR I 'Y S PSAOUT=1 Q

 I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),U),"." S PSAOUT=1 Q

 W:$Y @IOF S $P(PSALN,"*",81)="",PSAPG=PSAPG+1 W !?2,"Unlinked DRUG/ITEM MASTER file entries by common FSN",?55,PSARPDT,?70,"PAGE: "_PSAPG,!,PSALN,!,"DRUG file FSN",?40,"ITEM MASTER file"

 Q

PSALFS    ;BIR/LTL-Report Potential FSN Matches ;7/23/97

 +1       ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**15**; 10/24/97

 +2       ;

 +3       ;References to ^PSDRUG( are covered by IA #2095

 +4       ;References to ^PRC( are covered by IA #214

 +5       ;References to ^PSDRUG("AB" are covered by IA #2095

 +6       ;

 +7        DO DT^DICRW

DEV       ;asks device and queueing info

 +1        KILL IO("Q")

           NEW %ZIS,DTOUT,DUOUT,IOP,POP,PSAOUT

           SET %ZIS="Q"

           DO ^%ZIS

           IF POP

               WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"

               SET PSAOUT=1

               GOTO QUIT

 +2        IF $DATA(IO("Q"))

               NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK

               SET ZTRTN="START^PSALFS"

               SET ZTDESC="Unlinked DRUG/ITEM FILE matches by FSN"

               DO ^%ZTLOAD

               DO HOME^%ZIS

               SET PSAOUT=1

               GOTO QUIT

START     ;compiles and prints data for report

 +1        NEW DIR,DIRUT,PSAPG,POP,PSA,PSAD,PSADD,PSAF,PSAFSN,PSAIT,PSALN,PSARPDT,X,Y

           SET (PSA,PSAD,PSAPG,PSAOUT)=0

           SET Y=DT

           DO DD^%DT

           SET PSARPDT=Y

           DO HEADER

LOOP       FOR 

               SET PSAD=$ORDER(^PSDRUG(PSAD))

               IF 'PSAD

                   GOTO QUIT

               IF $Y+4>IOSL

                   DO HEADER

               IF PSAOUT

                   GOTO QUIT

               IF $PIECE($GET(^PSDRUG(PSAD,0)),U,6)]""

                   IF '$ORDER(^PSDRUG(PSAD,441,0))

                       IF '$DATA(^PSDRUG(PSAD,"I"))

                           Begin DoDot:1

 +1                            WRITE !!,$PIECE($GET(^PSDRUG(+PSAD,0)),U),!

FORM                           SET PSAFSN=$PIECE(^PSDRUG(PSAD,0),U,6)

                               WRITE !,PSAFSN

                               SET PSAIT=$ORDER(^PRC(441,"BB",PSAFSN,0))

                               IF 'PSAIT

                                   WRITE ?40,"No matching NSN in ITEM MASTER file"

                               IF 'PSAIT

                                   QUIT 

                               Begin DoDot:2

 +1                                Begin DoDot:3

USED                                   IF $ORDER(^PSDRUG("AB",PSAIT,""))

                                           SET PSADD=$ORDER(^PSDRUG("AB",PSAIT,""))

                                           WRITE !,"**"_$PIECE(^PSDRUG(PSADD,0),U)_" is already linked to Item #"_PSAIT_"**"

 +1                                    WRITE ?40,"ITEM Number:  "_PSAIT,!

                                   End DoDot:3

 +2                                IF $LENGTH($GET(^PRC(441,+PSAIT,1,1,0)))<40

                                       IF '$ORDER(^PRC(441,+PSAIT,1,1))

                                           WRITE ?40,$GET(^PRC(441,+PSAIT,1,1,0)),!

                                           QUIT 

 +3                                KILL ^UTILITY($JOB,"W")

                                   SET DIWL=40

                                   SET DIWR=80

                                   SET DIWF="W"

 +4                                FOR 

                                       SET PSA=$ORDER(^PRC(441,+PSAIT,1,PSA))

                                       IF 'PSA

                                           QUIT 

                                       SET X=$GET(^PRC(441,+PSAIT,1,PSA,0))

                                       DO ^DIWP

 +5                                DO ^DIWW

                                   SET PSA=0

                               End DoDot:2

                           End DoDot:1

QUIT       IF $EXTRACT(IOST)'="C"

               WRITE @IOF

 +1        IF $EXTRACT(IOST,1,2)="C-"

               IF '$GET(PSAOUT)

                   WRITE !!

                   SET DIR(0)="EA"

                   SET DIR("A")="END OF REPORT!  Press <RET> to return to the menu."

                   DO ^DIR

 +2        DO ^%ZISC

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

           KILL IO("Q")

 +3        QUIT 

HEADER    ;prints header info

 +1        IF $EXTRACT(IOST,1,2)'="P-"

               IF PSAPG

                   SET DIR(0)="E"

                   DO ^DIR

                   KILL DIR

                   IF 'Y

                       SET PSAOUT=1

                       QUIT 

 +2        IF $$S^%ZTLOAD

               WRITE !!,"Task #",$GET(ZTSK),", ",$GET(ZTDESC)," was stopped by ",$PIECE($GET(^VA(200,+$GET(DUZ),0)),U),"."

               SET PSAOUT=1

               QUIT 

 +3        IF $Y

               WRITE @IOF

           SET $PIECE(PSALN,"*",81)=""

           SET PSAPG=PSAPG+1

           WRITE !?2,"Unlinked DRUG/ITEM MASTER file entries by common FSN",?55,PSARPDT,?70,"PAGE: "_PSAPG,!,PSALN,!,"DRUG file FSN",?40,"ITEM MASTER file"

 +4        QUIT