| [613] | 1 | PSSOICT ;BIR/RTR-Orderable Item status ; 09/02/97 8:41
|
|---|
| 2 | ;;1.0;PHARMACY DATA MANAGEMENT;;9/30/97
|
|---|
| 3 | N PSSITE,QFLAG,AA,FF,FFFF,MMM,PSDATE,A,AA,APP,B,SS,ZZ,ZZZ
|
|---|
| 4 | S PSSITE=+$O(^PS(59.7,0)) I $P($G(^PS(59.7,PSSITE,80)),"^",2)'=2 W !!?3,$S($P($G(^(80)),"^",2)<2:"Orderable Item Auto-Create has not been completed!",1:"Manual Matching process complete!"),!! K PSSITE G EXIT
|
|---|
| 5 | W !,"This option looks at the 3 files that must be matched to the Orderable Item",!,"File, and tells you how many more need to be matched. The 3 files are:"
|
|---|
| 6 | W !!?5,"IV ADDITIVES File",!?5,"IV SOLUTIONS File",!?5,"DRUG File"
|
|---|
| 7 | W !!,"(Lists will not include drugs that do not require matching.)"
|
|---|
| 8 | W ! S %ZIS="QM" D ^%ZIS I POP G EXIT
|
|---|
| 9 | I $D(IO("Q")) D Q
|
|---|
| 10 | .S ZTRTN="BEG^PSSOICT",ZTDESC="Pharmacy Orderable Item Status Report" D ^%ZTLOAD K IO("Q") W !,"Report queued to print!",!
|
|---|
| 11 | BEG U IO
|
|---|
| 12 | S QFLAG=0
|
|---|
| 13 | ;I $E(IOST)="C" D DIRX I $G(Y)'=1 G EXIT
|
|---|
| 14 | S X1=DT,X2=-365 D C^%DTC S PDATE=X
|
|---|
| 15 | I $E(IOST)="C" W !!,"Finding IV ADDITIVES that aren't matched, hold on:" F II=1:1:3 W "." H 1
|
|---|
| 16 | I $E(IOST)'="C" D ADDHEAD
|
|---|
| 17 | S MM=0
|
|---|
| 18 | I $E(IOST)="C" W !
|
|---|
| 19 | F AA=0:0 S AA=$O(^PS(52.6,AA)) Q:'AA!($G(QFLAG)) I '$P($G(^PS(52.6,AA,0)),"^",11) D
|
|---|
| 20 | .S DD=$P($G(^PS(52.6,AA,0)),"^",2)
|
|---|
| 21 | .I 'DD Q
|
|---|
| 22 | .S FFFF=$P($G(^PS(52.6,AA,"I")),"^") I FFFF,FFFF<PDATE Q
|
|---|
| 23 | .D:MM=0 W !,$P($G(^PS(52.6,AA,0)),"^"),?41,"Still needs to be matched." S MM=MM+1 I ($Y+4)>IOSL D:$E(IOST)="C" DIRX D:$E(IOST)'="C" ADDHEAD S:$G(Y)'=1&($E(IOST)="C") QFLAG=1 I '$G(QFLAG)&($E(IOST)="C") W @IOF
|
|---|
| 24 | ..I $E(IOST)="C" W @IOF W !?5,"IV ADDITIVES that need matched:",!
|
|---|
| 25 | I $G(QFLAG) G EXIT
|
|---|
| 26 | I 'MM W !,"All IV ADDITIVES are matched that should be matched!",!
|
|---|
| 27 | I MM W $C(7),!!?3,MM," IV ADDITIVE(S) still need to be matched!",! H 1
|
|---|
| 28 | I $E(IOST)="C" D DIRX I $G(Y)'=1 G EXIT
|
|---|
| 29 | G ^PSSOICT1
|
|---|
| 30 | ;
|
|---|
| 31 | EXIT D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K ^TMP($J,"PSSLIST") Q
|
|---|
| 32 | DIRX ;
|
|---|
| 33 | W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue, '^' to Exit" D ^DIR K DIR Q
|
|---|
| 34 | ADDHEAD W @IOF W !,"IV ADDITIVE(S) THAT AREN'T MATCHED",!,"________________________________",! Q
|
|---|
