| 1 | PSOPRI ;BIR/JLC - INTERNET PRESCRIPTION REFILL PROCESSOR ;3/27/06 2:23pm
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**116,204,242,264**;DEC 1997;Build 19
|
|---|
| 3 | ;
|
|---|
| 4 | ;Reference to ^PPPPDA1 supported by DBIA 1374
|
|---|
| 5 | ;Reference to ^PSSLOCK supported by DBIA 2789
|
|---|
| 6 | ;Reference to DIC(19 supported by DBIA 2246
|
|---|
| 7 | ;
|
|---|
| 8 | ;PSO*242 do not init PSODFN, it should only be set by label print
|
|---|
| 9 | ;
|
|---|
| 10 | START L +^XTMP("PSOATRF"):5 I '$T D Q
|
|---|
| 11 | .D BMES^XPDUTL("The scheduled job is currently running - Please try it later.")
|
|---|
| 12 | .D MES^XPDUTL("")
|
|---|
| 13 | L -^XTMP("PSOATRF") S PSOVEX=1
|
|---|
| 14 | K PSOVEXI,PSOISITE,PSOVEXFL,PSONOF
|
|---|
| 15 | S PSOVX=0 F S PSOVX=$O(^PS(59,PSOVX)) Q:'PSOVX I $P($G(^PS(59,PSOVX,"I")),"^"),DT>$P($G(^("I")),"^") S PSOVEXI(PSOVX)=""
|
|---|
| 16 | I $O(PSOVEXI(0)) W !,"Looking for refill requests for inactive Outpatient divisions..." D
|
|---|
| 17 | . S PSOVIN=0 F S PSOVIN=$O(^PS(52.43,"AINST",PSOVIN)) Q:'PSOVIN S PSOVXLP="" F S PSOVXLP=$O(^PS(52.43,"AINST",PSOVIN,PSOVXLP)) Q:PSOVXLP="" D
|
|---|
| 18 | .. S PSOIEN=$O(^PS(52.43,"AINST",PSOVIN,PSOVXLP,""))
|
|---|
| 19 | .. S PSOISITE=$P($G(^PSRX(PSOVXLP,2)),"^",9) Q:$G(PSOVEXI(+$G(PSOISITE)))
|
|---|
| 20 | .. I PSOISITE,$D(PSOVEXI(PSOISITE)),$P($G(^PS(52.43,PSOIEN,0)),"^",5)="" S PSOVEXI(PSOISITE)=1,PSOVEXFL=1
|
|---|
| 21 | . I '$G(PSOVEXFL) W ".none found.",!
|
|---|
| 22 | I $G(PSOVEXFL) W !!,"The following Inactive Outpatient sites have refill requests:",! D I Y'=1 G END
|
|---|
| 23 | . S PSOVX=0 F S PSOVX=$O(PSOVEXI(PSOVX)) Q:'PSOVX I $G(PSOVEXI(PSOVX)) W !?5,$P($G(^PS(59,+$G(PSOVX),0)),"^")
|
|---|
| 24 | . K DIR W ! S DIR(0)="E",DIR("A")="Press Return to Continue, '^' to exit" D ^DIR W ! I Y'=1 Q
|
|---|
| 25 | D:'$D(PSOPAR) ^PSOLSET G:'$D(PSOPAR) END
|
|---|
| 26 | W !!!?20,"Division: "_$P(^PS(59,PSOSITE,0),"^"),!!
|
|---|
| 27 | S PSOBBC1("FROM")="REFILL",PSOBBC("QFLG")=0,PSOBBC("DFLG")=0
|
|---|
| 28 | I '$D(^PS(52.43,"AINST",PSOINST)) S PSOANS="N" W !!?7,$C(7),"There are no internet refills to process." G END
|
|---|
| 29 | D ASK^PSOBBC W:PSOBBC("QFLG")=1 !?7,$C(7),"No internet refills were processed." G:PSOBBC("QFLG")=1 END
|
|---|
| 30 | IPR W ! S DIR("B")="YES",DIR("A")="Process internet refill requests at this time",DIR(0)="Y" D ^DIR K DIR S PSOANS="N" I $G(DIRUT) S PSOPTRX="" G END
|
|---|
| 31 | G:Y=0 END S PSOPTRX="" I Y=1 S PSOANS="Y"
|
|---|
| 32 | I PSOANS["Y" S DIR("B")="NO",DIR("A")="Process internet refills for all divisions",DIR(0)="Y" D ^DIR K DIR S PSOANS2="S" S:Y=1 PSOANS2="M" I $G(DIRUT) S PSOANS="N" G END
|
|---|
| 33 | IPR6 I PSOANS["Y",$G(PSOPTRX),'$G(PSOMHV) D IPR5 ;MARK PROCESSED NODES
|
|---|
| 34 | D IPR3 I $G(PSOANS)="N" D ULK G END
|
|---|
| 35 | ;I $P(X,"-")'=PSOINST W !?7,$C(7),$C(7),$C(7),"Not from this institution.",! D ULK G IPR6
|
|---|
| 36 | S (PSOBBC("IRXN"),PSOBBC("OIRXN"))=$P(X,"-",2)
|
|---|
| 37 | I $G(^PSRX(PSOBBC("IRXN"),0))']"" W !,$C(7),"Rx data is not on file!",! D ULK G IPR6
|
|---|
| 38 | I $P($G(^PSRX(PSOBBC("IRXN"),"STA")),"^")=13 W !,$C(7),"Rx has already been deleted." D ULK G IPR6
|
|---|
| 39 | I $G(PSOBBC("DONE"))[PSOBBC("IRXN")_"," W !,$C(7),"Rx has already been entered." D ULK G IPR6
|
|---|
| 40 | K X,Y D:PSOBBC("QFLG") PROCESSX^PSOBBC
|
|---|
| 41 | S PSOSELSE=0 I $G(PSODFN)'=$P(^PSRX(PSOBBC("IRXN"),0),"^",2) S PSOSELSE=1 D PT^PSOBBC I $G(PSOBBC("DFLG")) K PSOSELSE D ULK G IPR6
|
|---|
| 42 | I '$G(PSOSELSE) D PTC^PSOBBC I $G(PSOBBC("DFLG")) K PSOSELSE D ULK G IPR6
|
|---|
| 43 | K PSOSELSE D PROFILE^PSORX1 S X="PPPPDA1" X ^%ZOSF("TEST") I S X=$$PDA^PPPPDA1(PSODFN) W !!
|
|---|
| 44 | S PSOBBC("DONE")=PSOBBC("IRXN")_",",PSOMHV=0 D REFILL^PSOBBC D ULK G IPR6
|
|---|
| 45 | Q
|
|---|
| 46 | IPR3 K PSOBBC("IRXN"),PSOXFLAG F S PSOPTRX=$O(^PS(52.43,"AINST",PSOINST,PSOPTRX)) D Q:PSOANS="N"!($G(PSOXFLAG))
|
|---|
| 47 | .I PSOPTRX="" S PSOANS="N" Q
|
|---|
| 48 | .S PSOIEN=$O(^PS(52.43,"AINST",PSOINST,PSOPTRX,""))
|
|---|
| 49 | .I '$D(^PSRX(+PSOPTRX,0)),$P(^PS(52.43,PSOIEN,0),"^",5)="" S PSONOF=1 D IPR5 K PSONOF Q ;SKIPS ERRONEOUS ENTRIES
|
|---|
| 50 | IPR4 .I PSOANS["Y" Q:$P(^PS(52.43,PSOIEN,0),"^",5)'="" S X=PSOINST_"-"_PSOPTRX ;SKIPS ENTRIES ALREADY PROCESSED AND FORMATS VARIABLE X
|
|---|
| 51 | IPR10 .I PSOANS2["S",$D(^PSRX(+PSOPTRX,0)),PSOSITE'=$P($G(^PSRX(+PSOPTRX,2)),"^",9) Q
|
|---|
| 52 | .S PSOPSORX=+$G(PSOPTRX) I PSOPSORX D PSOL^PSSLOCK(PSOPSORX) I '$G(PSOMSG) K PSOPSORX,PSOMSG Q
|
|---|
| 53 | .K PSOMSG S PSOXFLAG=1
|
|---|
| 54 | Q
|
|---|
| 55 | ;LINES CALLED TO MARK PROCESSED NODES
|
|---|
| 56 | IPR5 K DA,DR,DIE S DA=$O(^PS(52.43,"AINST",PSOINST,PSOPTRX,""))
|
|---|
| 57 | S DIE="^PS(52.43,",DR="5////"_DT_";6///"_$S($G(PSOBBC("DFLG"))=1:"NOT FILLED",$G(PSONOF)=1:"NOT FILLED",1:"FILLED") D ^DIE ; MARKS NODE AS PROCESSED
|
|---|
| 58 | K ^PS(52.43,"AINST",PSOINST,PSOPTRX,DA)
|
|---|
| 59 | Q
|
|---|
| 60 | END D PROCESSX^PSOBBC
|
|---|
| 61 | I $P($G(^PS(59,+$G(PSOSITE),"I")),"^"),DT>$P($G(^("I")),"^") D FINAL^PSOLSET W !!,"Your Outpatient Site parameters have been deleted because you selected an",!,"inactive Outpatient Site!",!
|
|---|
| 62 | K DIR,PSOBBC,PSOBBC1,PSOVIN,PSOISITE,PSOVEXFL,PSOVXLP,PSOVEX,PSOVX,PSOVEXI,PSOANS,PSOANS2,PSOPTRX,PSOXFLAG,PSOPSORX,X,Y,PSODFN,PSOMHV
|
|---|
| 63 | Q
|
|---|
| 64 | ULK ;
|
|---|
| 65 | I '$G(PSOPSORX) Q
|
|---|
| 66 | D PSOUL^PSSLOCK(PSOPSORX)
|
|---|
| 67 | K PSOPSORX
|
|---|
| 68 | Q
|
|---|
