1 | PSSCREAT ;BIR/RTR/WRT-Auto create Pharmacy Orderable Item File; 09/01/98 7:07
|
---|
2 | ;;1.0;PHARMACY DATA MANAGEMENT;**8,15**;9/30/97
|
---|
3 | CHECK ; make sure file has not already been created"
|
---|
4 | S PSSITE=+$O(^PS(59.7,0)) I $P($G(^PS(59.7,+PSSITE,80)),"^",2) W !!?3,"Orderable Item Auto-Create has ",$S($P(^(80),"^",2)=1:"already been queued,",1:"already been completed,")," no action taken!",! K PSSITE D Q
|
---|
5 | .K DIR S DIR("A")="Press RETURN to continue",DIR(0)="E" D ^DIR K DIR
|
---|
6 | S $P(^PS(59.7,PSSITE,80),"^",2)=1
|
---|
7 | PRI K DIR W !!,"This job will create your Pharmacy Orderable Item File, and match IV Solutions,",!,"IV Additives, and Dispense Drugs to the Pharmacy Orderable Item File."
|
---|
8 | S DIR("A",1)="Enter P to create your Pharmacy Orderable Item File first by Primary Drug",DIR("A",2)="Name, then by VA Generic Name",DIR("A",3)="Enter V to create the Pharmacy Orderable Item File by VA Generic Name only"
|
---|
9 | S DIR("A",4)="",DIR("A")="Enter P or V"
|
---|
10 | S DIR(0)="S^P:PRIMARY/VA GENERIC;V:VA GENERIC" D ^DIR K DIR I Y["^"!($D(DTOUT))!($D(DUOUT)) S $P(^PS(59.7,PSSITE,80),"^",2)="" G ENDTWO
|
---|
11 | S PSOHOW=Y
|
---|
12 | W !,"This job should be queued to run at night!",!
|
---|
13 | D NOW^%DTC K %DT S %DT="FRAEX",%DT(0)=%,%DT("A")="QUEUE TO RUN AT WHAT TIME: " D ^%DT S PSOQTIME=Y I $D(DTOUT)!(Y=-1) W !!,"Try again later!",! S $P(^PS(59.7,PSSITE,80),"^",2)="" G ENDTWO
|
---|
14 | S PSOMDUZ=DUZ,ZTIO="",ZTRTN="BEG^PSSCREAT",ZTDTH=PSOQTIME,ZTDESC="AUTO CREATE ORDERABLE ITEM FILE",ZTSAVE("PSCREATE")="",ZTSAVE("PSOHOW")="",ZTSAVE("PSOMDUZ")="",ZTSAVE("PSSITE")="" D ^%ZTLOAD W !!,"TASK QUEUED!",! G ENDTWO
|
---|
15 | BEG ;
|
---|
16 | S PSCREATE=1
|
---|
17 | I PSOHOW="P" D ^PSSSPD G START
|
---|
18 | D IVADD^PSSSPD
|
---|
19 | START K ^TMP("PSSD",$J),^TMP("PSS",$J),^TMP("PSSADD",$J),^TMP("PSSOL",$J)
|
---|
20 | F RRR=0:0 S RRR=$O(^PSDRUG(RRR)) Q:'RRR S (FLAGONE,FLAGTWO)=0 D D:$G(FLAGONE) MATCH D:$G(FLAGTWO) ADD
|
---|
21 | .S NODE=$G(^PSDRUG(RRR,"ND")),SUPER=$P($G(^PSDRUG(RRR,2)),"^"),DA=$P($G(NODE),"^"),K=$P($G(NODE),"^",3),X=$$PSJDF^PSNAPIS(DA,K),DF1=X,DA=$P($G(NODE),"^"),X=$$VAGN^PSNAPIS(DA),GEN=X
|
---|
22 | .I +SUPER Q
|
---|
23 | .K ^TMP($J,"PSSIP") I +$P(NODE,"^"),+$P(NODE,"^",3) F VV=0:0 S VV=$O(^PSDRUG("AND",+NODE,VV)) Q:'VV I +$P($G(^PSDRUG(VV,2)),"^"),$D(^PS(50.7,$P(^PSDRUG(VV,2),"^"),0)) D
|
---|
24 | ..S OTH=$G(^PSDRUG(VV,"ND")) I +$P(OTH,"^"),+$P(OTH,"^",3),$G(DF1) S DA=$P($G(OTH),"^"),K=$P($G(OTH),"^",3),X=$$PSJDF^PSNAPIS(DA,K),DF2=X I $G(DF2) D
|
---|
25 | ...I $G(DF1)=$G(DF2) S ^TMP($J,"PSSIP",VV)=$P(^PSDRUG(VV,2),"^")
|
---|
26 | .S (COMM,COMMON)=0 I $O(^TMP($J,"PSSIP",0)) S COMM=1 S CC=$O(^TMP($J,"PSSIP",0)),SPRIM=^TMP($J,"PSSIP",CC) F WW=0:0 S WW=$O(^TMP($J,"PSSIP",WW)) Q:'WW I SPRIM'=^TMP($J,"PSSIP",WW) S COMMON=1
|
---|
27 | .I COMM,COMMON Q
|
---|
28 | .I COMM,'COMMON S FLAGONE=1 Q
|
---|
29 | .I +$P(NODE,"^"),+$P(NODE,"^",3),$G(GEN)'=0,$G(DF1) D
|
---|
30 | ..I $L(GEN)<41 S SPNAME=GEN,SPNTR=$P(DF1,"^"),FLAGTWO=1 Q
|
---|
31 | END D ENDONE D DATE^PSSPOIM1 K RRR,STOP,^TMP($J,"PSSIP") D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
|
---|
32 | ;
|
---|
33 | MATCH ;Match to an already existing Orderable Item
|
---|
34 | S DA=RRR,DIE="^PSDRUG(",DR="2.1////"_SPRIM D ^DIE D ENDONE Q
|
---|
35 | ADD ;Create a new Orderable Item entry
|
---|
36 | S STOP=0 F CHECK=0:0 S CHECK=$O(^PS(50.7,"ADF",SPNAME,SPNTR,CHECK)) Q:'CHECK!(STOP) I CHECK,$P($G(^PS(50.7,CHECK,0)),"^",3)="" S STOP=1,DIE="^PSDRUG(",DA=RRR,DR="2.1////"_CHECK D ^DIE D ENDONE Q
|
---|
37 | I STOP K STOP Q
|
---|
38 | K DD,DO S X=SPNAME,DIC="^PS(50.7,",DIC(0)="L",DIC("DR")=".02////"_SPNTR D FILE^DICN I 'Y D ENDONE Q
|
---|
39 | S SPIEN=+Y S DIE="^PSDRUG(",DA=RRR,DR="2.1////"_SPIEN D ^DIE
|
---|
40 | ENDONE K APP,CC,CHECK,COMM,COMMON,DA,DR,DIE,DIC,FLAGONE,FLAGTWO,NODE,OTH,PSDOS,PSOQTIME,SPIEN,SPNAME,SPNTR,SPRIM,SUPER,VV,WW Q
|
---|
41 | ;
|
---|
42 | MAIL ;
|
---|
43 | S PSSADATE=DT F TTTT=0:0 S TTTT=$O(^PS(50.7,TTTT)) Q:'TTTT D
|
---|
44 | .I '$P($G(^PS(50.7,TTTT,0)),"^",3) D
|
---|
45 | ..S (PSSLTST,PSSIFLAG)=0 F JJJJ=0:0 S JJJJ=$O(^PSDRUG("ASP",TTTT,JJJJ)) Q:'JJJJ S PSSIOU=$P($G(^PSDRUG(JJJJ,2)),"^",3) I PSSIOU["I"!(PSSIOU["O")!(PSSIOU["U") S PSSVARP=+$P($G(^PSDRUG(JJJJ,"I")),"^") D
|
---|
46 | ...S:PSSVARP&(PSSVARP>PSSLTST) PSSLTST=PSSVARP I 'PSSVARP S PSSIFLAG=1
|
---|
47 | .I '$P($G(^PS(50.7,TTTT,0)),"^",3),'$P($G(^(0)),"^",4),'PSSIFLAG K DIE S DIE="^PS(50.7,",DA=TTTT,DR=".04////"_$S('PSSLTST:PSSADATE,1:PSSLTST) D ^DIE K DIE
|
---|
48 | .I $P($G(^PS(50.7,TTTT,0)),"^",3) D
|
---|
49 | ..S (PSSLTST,PSSIFLAG)=0 F JJJJ=0:0 S JJJJ=$O(^PS(52.6,"AOI",TTTT,JJJJ)) Q:'JJJJ I $D(^PS(52.6,JJJJ,0)) S PSSVARP=+$P($G(^("I")),"^") D
|
---|
50 | ...S:PSSVARP&(PSSVARP>PSSLTST) PSSLTST=PSSVARP I 'PSSVARP S PSSIFLAG=1
|
---|
51 | ..F JJJJ=0:0 S JJJJ=$O(^PS(52.7,"AOI",TTTT,JJJJ)) Q:'JJJJ I $D(^PS(52.7,JJJJ,0)) S PSSVARP=+$P($G(^("I")),"^") D
|
---|
52 | ...S:PSSVARP&(PSSVARP>PSSLTST) PSSLTST=PSSVARP I 'PSSVARP S PSSIFLAG=1
|
---|
53 | .I $P($G(^PS(50.7,TTTT,0)),"^",3),'$P($G(^(0)),"^",4),'PSSIFLAG K DIE S DIE="^PS(50.7,",DA=TTTT,DR=".04////"_$S('PSSLTST:PSSADATE,1:PSSLTST) D ^DIE K DIE
|
---|
54 | K PSSVARP,PSSIOU,PSSADATE,TTTT,JJJJ,PSSIFLAG,PSSLTST D ^PSSSYN K NUM,NUMB,POI,SYNO
|
---|
55 | ;
|
---|
56 | S XMDUZ="PHARMACY DATA MANAGEMENT PACKAGE",XMY(.5)="",XMY(PSOMDUZ)="",XMSUB="Pharmacy Orderable Item Auto-Create"
|
---|
57 | S PSSATEXT(1)="The Pharmacy Orderable Item Auto-create has successfully run to",PSSATEXT(2)="Completion! You may now begin the manual matching process."
|
---|
58 | S XMTEXT="PSSATEXT(" D ^XMD S:'$G(PSSITE) PSSITE=+$O(^PS(59.7,0)) S $P(^PS(59.7,PSSITE,80),"^",2)=2 Q
|
---|
59 | ENDTWO D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K PSOMDUZ,PSSITE Q
|
---|