source: WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSABRKU4.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1PSABRKU4 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data - CONT'D ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26,64**; 10/24/97;Build 4
3XTMP ;This modules copies the prime vendor data in ^TMP($J,"PSAPV SET") to
4 ;^XTMP("PSAPV"). The data has passed all X12 checks.
5 ;
6 S X1=DT,X2=21 D C^%DTC L +^XTMP("PSAPV",0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I '$T Q
7 S ^XTMP("PSAPV",0)=X_"^"_DT_"^Drug Accountability Prime Vendor Uploaded Invoice Data"
8 ;
9 ;Sets array of orders & invoices in XTMP (uploaded or processed).
10 S PSACTRL=0 F S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:'PSACTRL D
11 .Q:'$D(^XTMP("PSAPV",PSACTRL,"IN"))
12 .S PSAIN=^XTMP("PSAPV",PSACTRL,"IN")
13 .;DAVE B PSA*3*3 - Incomplete invoice deletion
14 .I $P(PSAIN,"^",2)=""!($P(PSAIN,"^",4)="") K ^XTMP("PSAPV",PSACTRL) Q
15 .S PSADUP($P(PSAIN,"^",4),$P(PSAIN,"^",2))=$S($P(PSAIN,"^",8)="P":"P",1:"U")
16DUPLICAT ;
17 ;Sets XTMP if incoming order & invoice is not a duplicate.
18 S (PSACTRL,PSADUP)=0
19 F S PSACTRL=$O(^TMP($J,"PSAPV SET",PSACTRL)) S PSASET=PSACTRL Q:PSACTRL="" D S PSACTRL=PSASET
20DAV .;
21 .I $D(^XTMP("PSAPV",PSASET,"IN")) S DATA=^("IN") I $P(^TMP($J,"PSAPV SET",PSACTRL,"IN"),"^",4)'=$P(DATA,"^",4),$P(^TMP($J,"PSAPV SET",PSACTRL,"IN"),"^",2)'=$P(DATA,"^",2) S PSACHKR=1
22 .I $D(PSACHKR) F S PSASET=$G(PSASET)+.01 I '$D(^XTMP("PSAPV",PSASET)) K PSACHKR Q
23 .;
24 .S PSASEG="" F S PSASEG=$O(^TMP($J,"PSAPV SET",PSACTRL,PSASEG)) Q:PSASEG="" S PSADUP=0 D
25 ..I PSASEG'="IT" D Q
26 ...I PSASEG="IN" S PSAIN=^TMP($J,"PSAPV SET",PSACTRL,PSASEG) D Q
27 ....I $P(PSAIN,"^",2)=""!($P(PSAIN,"^",4)="") K ^TMP($J,"PSAPV SET",PSACTRL) Q
28 ....D CHKDUP Q:PSADUP
29 ....S ^XTMP("PSAPV",PSASET,"IN")=^TMP($J,"PSAPV SET",PSACTRL,PSASEG)
30 ....D DATES
31 ....S PSAORD=$P($G(^TMP($J,"PSAPV SET",PSACTRL,"IN")),"^",4),PSAINV=$P($G(^("IN")),"^",2),PSAORDDT=$P($G(^("IN")),"^",3),PSAINVDT=$P($G(^("IN")),"^")
32 ....S PSAGUI2(PSAORD)="",PSAGUI3(PSAINV)=""
33 ....S ^TMP($J,"PSA GUI",PSAORD,PSAINV)=""
34 ...I PSASEG'="IN" S ^XTMP("PSAPV",PSASET,PSASEG)=^TMP($J,"PSAPV SET",PSACTRL,PSASEG)
35 ..I PSASEG="IT" S PSALINE=0 F S PSALINE=$O(^TMP($J,"PSAPV SET",PSACTRL,PSASEG,PSALINE)) Q:'PSALINE S ^XTMP("PSAPV",PSASET,PSASEG,PSALINE)=^TMP($J,"PSAPV SET",PSACTRL,PSASEG,PSALINE),PSAGUI4=$G(PSAGUI4)+1
36 .K ^TMP($J,"PSAPV SET",PSACTRL)
37 .I '$D(^XTMP("PSAPV",PSASET,"IT")) K ^XTMP("PSAPV",PSASET)
38 L -^XTMP("PSAPV",0)
39 Q
40 ;
41CHKDUP ;Checks for duplicate orders & invoices and duplicates in XTMP.
42 I $D(PSADUP($P(PSAIN,"^",4),$P(PSAIN,"^",2))) S PSASTA=PSADUP($P(PSAIN,"^",4),$P(PSAIN,"^",2)),PSADUP=1 D Q
43 .S X12="** Order# "_$P(PSAIN,"^",4)_", invoice# "_$P(PSAIN,"^",2)_" has been "
44 .I PSASTA="U" S X12=X12_"uploaded and" D SETMSG^PSABRKU8 S X12="is awaiting processing. It cannot be uploaded more than once." D SETMSG^PSABRKU8
45 .I PSASTA'="U" S X12=X12_" processed and" D SETMSG^PSABRKU8 S X12="is being prepared for verification. It cannot be uploaded more than once." D SETMSG^PSABRKU8
46 .K ^TMP($J,"PSAPV SET",PSACTRL) Q
47 ;
48 Q:'$D(^PSD(58.811,"AORD",$P(PSAIN,"^",4),$P(PSAIN,"^",2)))
49 ;
50 ;Checks for duplicates in 58.811
51 S PSAORD=$P(PSAIN,"^",4),PSAINV=$P(PSAIN,"^",2),PSAORDN=$O(^PSD(58.811,"B",PSAORD,0)) Q:'PSAORDN
52 S PSAINVN=$O(^PSD(58.811,PSAORDN,1,"B",PSAINV,0)) Q:'PSAINVN
53 Q:'$D(^PSD(58.811,PSAORDN,1,PSAINVN,0))
54 S PSAIN=^PSD(58.811,PSAORDN,1,PSAINVN,0),PSASTA=$P(PSAIN,"^",3),PSAPC=$S(PSASTA="P":6,PSASTA="V"!(PSASTA="C"):8,1:0)
55 S (PSADT,PSALINE)=0 F S PSALINE=$O(^PSD(58.811,PSAORDN,1,PSAINVN,1,PSALINE)) Q:'PSALINE!($G(PSADT)) S PSADT=+$P($G(^PSD(58.811,PSAORDN,1,PSAINVN,1,PSALINE,0)),"^",PSAPC)
56 S X12="** Order# "_PSAORD_" Invoice# "_PSAINV
57 S:+PSADT PSADT=$E(PSADT,4,5)_"/"_$E(PSADT,6,7)_"/"_$E(PSADT,2,3)
58 I PSASTA="P" S X12=X12_" has been processed"_$S(+PSADT:" on "_PSADT,1:"")_" and" D SETMSG^PSABRKU8 S X12=" is awaiting verification. It cannot be uploaded more than once." D SETMSG^PSABRKU8
59 I PSASTA="V" S X12=X12_" has been verified"_$S(+PSADT:" on "_PSADT,1:"")_"and" D SETMSG^PSABRKU8 S X12=" is updating the pharmacy location. It cannot be uploaded more than once." D SETMSG^PSABRKU8
60 I PSASTA="C" S X12=X12_" has been completed." D SETMSG^PSABRKU8 S X12=" It cannot be uploaded more than once." D SETMSG^PSABRKU8
61 ;
62KILLDUP S PSADUP=1
63 K ^TMP($J,"PSAPV SET",PSACTRL),^XTMP("PSAPV",PSASET)
64 Q
65PRT2 ;Extended help to second "Print invoices?"
66 W !?5,"Enter YES to print all invoices that are not processed and",!?5,"the invoices that were processed while you were in this option.",!!?5,"Enter NO to exit the option."
67 Q
68YNPRINT ;Extended help to "Print invoices?"
69 W !?5,"Enter YES to print the uploaded invoices. You",!?5,"can check the invoices prior to processing them.",!!?5,"Enter NO to not print the invoices."
70 Q
71 ;
72YNPROCES ;Extended help to "Do you want to process the invoices now?"
73 W !?5,"Enter YES to begin processing the uploaded invoices.",!!?5,"Enter NO if you do not want to process the invoices now. You can process"
74 W !?5,"them later by selecting the ""Process Uploaded Prime Vendor Invoice Data"" option."
75 Q
76 ;
77YNUPLOAD ;Extended help to "Are you ready to upload the prime vendor invoice data?"
78 W !?5,"Enter YES to start uploading the invoices.",!?5,"Enter NO or ""^"" to exit the option."
79 Q
80 ;
81DATES ;PSA*3*12 Check for Y2K compliance of dates
82 S DATECHK=0
83 F X=1,3,5,6 S XX=$P(^XTMP("PSAPV",PSASET,"IN"),"^",X) I $L(XX)=8 S XXX=($E(XX,1,4)-1700)_$E(XX,5,8),$P(^XTMP("PSAPV",PSASET,"IN"),"^",X)=XXX,DATECHK=1
84 I DATECHK Q
85 S LWRDT=$E(DT,1,3)-70,UPPRDT=$E(DT,1,3)+30
86 F Y=1,3,5,6 S DT1=$E(DT,1)_$E($P(^XTMP("PSAPV",PSASET,"IN"),"^",Y),1,2),$P(^XTMP("PSAPV",PSASET,"IN"),"^",Y)=$S((DT1>LWRDT&(DT1<UPPRDT)):$E(DT1)_$P(^XTMP("PSAPV",PSASET,"IN"),"^",Y),1:($E(DT1,1)+1)_$P(^XTMP("PSAPV",PSASET,"IN"),"^",Y))
87 F X=1,3,5,6 S XX=$P(^XTMP("PSAPV",PSASET,"IN"),"^",X) I XX>(DT+300000) S XXX=$E(XX,1)-2,$P(^XTMP("PSAPV",PSASET,"IN"),"^",X)=XXX_$E(XX,2,99)
88 F X=1,3,5,6 S XX=$P(^XTMP("PSAPV",PSASET,"IN"),"^",X) I XX'?7N S $P(^XTMP("PSAPV",PSASET,"IN"),"^",X)=DT
89 K LWRDT,UPPRDT,DT1,X,Y,XXX,XX
Note: See TracBrowser for help on using the repository browser.