source: FOIAVistA/tag/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSCREAT.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1PSSCREAT ;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
3CHECK ; 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
7PRI 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
15BEG ;
16 S PSCREATE=1
17 I PSOHOW="P" D ^PSSSPD G START
18 D IVADD^PSSSPD
19START 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
31END D ENDONE D DATE^PSSPOIM1 K RRR,STOP,^TMP($J,"PSSIP") D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
32 ;
33MATCH ;Match to an already existing Orderable Item
34 S DA=RRR,DIE="^PSDRUG(",DR="2.1////"_SPRIM D ^DIE D ENDONE Q
35ADD ;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
40ENDONE 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 ;
42MAIL ;
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
59ENDTWO D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K PSOMDUZ,PSSITE Q
Note: See TracBrowser for help on using the repository browser.