Changeset 623 for WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAPROC7.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAPROC7.m
r613 r623 1 PSAPROC7 ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;9/6/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,27,21,42,61,64,67**; 10/24/97;Build 15 3 ;This routine takes the data in XTMP and moves it to DA ORDERS file. 4 ;It deletes the data in XTMP after it is copies. 5 ; 6 ;References to ^PSDRUG( are covered by IA #2095 7 INVOICE ;PSA*3*21 (3JAN01) - FILE INVOICE IMMEDIATELY 8 ; 9 S PSAIN=$G(^XTMP("PSAPV",PSACTRL,"IN")) Q:PSAIN="" 10 Q:$P(PSAIN,"^",8)'="P" 11 S PSAORD=$P(PSAIN,"^",4),PSAIEN=+$O(^PSD(58.811,"B",PSAORD,0)),PSACRED=0 12 I 'PSAIEN D 13 .F L +^PSD(58.811,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 14 .;(PSA*3*24 - Dave B. Jun 2 00 - Improper DIC call) 15 .;(PSA*3*61 - add N DO. DICN will use DO if defined, we do not want to use it since DIC is defined. 16 .N DO S DIC="^PSD(58.811,",DIC(0)="L",X=PSAORD D FILE^DICN K DIC L -^PSD(58.811,0) S PSAIEN=+Y 17 F L +^PSD(58.811,PSAIEN,0):10 I Q 18 S:'$D(^PSD(58.811,PSAIEN,1,0)) DIC("P")=$P(^DD(58.811,2,0),"^",2) 19 S DA(1)=PSAIEN,DIC="^PSD(58.811,"_DA(1)_",1,",DIC(0)="L",X=$P(PSAIN,"^",2),DLAYGO=58.811 D ^DIC K DA,DLAYGO S PSAIEN1=+Y 20 S DA(1)=PSAIEN,DA=PSAIEN1,DIE=DIC K DIC 21 S PSALOCDR=$P($G(PSAIN),"^",7) 22 S PSADELDR=$P($G(PSAIN),"^",6) 23 S PSACSDR=$S($P(PSAIN,"^",10)="ALL CS":"A",$P(PSAIN,"^",9)="CS":"S",1:"N") 24 S PSARECD=$P($G(PSAIN),"^",11) 25 S PSAMV=$S(+$P(PSAIN,"^",12):$P(PSAIN,"^",12),1:"") 26 S PSASUP=$S($P(PSAIN,"^",13)="SUP":1,1:"") 27 ;DAVE B ( PSA*3*12) Invalid Concatenation of zero node 28 S ^PSD(58.811,DA(1),1,DA,0)=$P(^(0),"^")_"^"_$P(PSAIN,"^",1)_"^P^"_$P(PSAIN,"^",3)_"^"_$G(PSALOCDR)_"^"_$G(PSADELDR)_"^"_$G(PSARECD)_"^"_$G(PSACSDR)_"^^"_DUZ_"^^"_$G(PSAMV)_"^"_$G(PSASUP) 29 S DIK=DIE D IX^DIK 30 K ^TMP($J,"PSADIF"),PSADIFLC ;*42 pre verify storage for OU, DUOU, Cost, NDC changes 31 S PSALINE=0 F S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:PSALINE="" D LINE 32 D SCANDIF,MM ;*42 look for differences to drug file SEND EMAIL 33 I PSACRED K DA S DA(1)=PSAIEN,DA=PSAIEN1,DIE="^PSD(58.811,"_DA(1)_",1,",DR="10///^S X=1" D ^DIE K DIE 34 S $P(^PSD(58.811,PSAIEN,0),"^",2)=$P($G(^XTMP("PSAPV",PSACTRL,"DS")),"^") 35 L -^PSD(58.811,PSAIEN,0) 36 K ^XTMP("PSAPV",PSACTRL) 37 Q 38 ; 39 LINE ;Files line items. 40 S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE) S:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,0)) DIC("P")=$P(^DD(58.8112,5,0),"^",2) 41 ;PSA*3*31 Dave B - Check for invoice already in file 42 S DA(2)=PSAIEN,DA(1)=PSAIEN1,(DA,X)=PSALINE,DIC="^PSD(58.811,"_DA(2)_",1,"_DA(1)_",1,",DIC(0)="L",DLAYGO=58.811 D ^DIC S PSAIEN2=+Y K DA,DIC,DLAYGO 43 ; 44 ;DAVEB PSA*3*3 (5may98) 45 S PSADRG=$P($G(PSADATA),"^",6) 46 S PSASYN=$P($G(PSADATA),"^",7) 47 K PSAUNIT 48 I $G(PSASYN)'="",$G(PSADRG)'="" S PSAUNIT=+$P($G(^PSDRUG(PSADRG,1,PSASYN,0)),"^",5) 49 ; 50 ;DAVE B (PSA*3*12) Assignment of order unit didn't take into 51 ;account the adjusted order unit. 52 S PSAUNIT=$S($D(PSAUNIT):PSAUNIT,$P(PSADATA,"^",12)'="":$P(PSADATA,"^",12),+$P($P(PSADATA,"^",2),"~",2):+$P($P(PSADATA,"^",2),"~",2),1:0) 53 S PSACS=$S($P(PSADATA,"^",19)="CS":1,1:0),PSANDC=$P($P(PSADATA,"^",4),"~"),PSAVSN=$P($P(PSADATA,"^",5),"~"),PSAUPC=$P($P(PSADATA,"^",26),"~") 54 I PSANDC="",$P($P(PSADATA,"^",26),"~")'="" S PSANDC="S"_$P($P(PSADATA,"^",26),"~") 55 S DA(2)=PSAIEN,DA(1)=PSAIEN1,DA=$S($D(PSAIEN2):PSAIEN2,1:PSALINE),DIE="^PSD(58.811,"_DA(2)_",1,"_DA(1)_",1," 56 ;DaveB (4may98) hard code filing data 57 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",3)=+PSADATA 58 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",11)=PSANDC 59 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",12)=PSAVSN 60 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",13)=PSAUPC 61 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",10)=PSACS 62 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",2)=PSADRG 63 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",4)=PSAUNIT 64 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",5)=$P(PSADATA,"^",3) 65 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",6)=DT 66 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",7)=DUZ 67 ;BGN 67 68 S $P(^PSD(58.811,DA(2),1,DA(1),3,DA,0),"^",1)=$P(PSADATA,"^",28) 69 S $P(^PSD(58.811,DA(2),1,DA(1),3,DA,0),"^",2)=$P(PSADATA,"^",29) 70 S $P(^PSD(58.811,DA(2),1,DA(1),3,DA,0),"^",3)=$P(PSADATA,"^",30) 71 S $P(^PSD(58.811,DA(2),1,DA(1),3,DA,0),"^",4)=$P(PSADATA,"^",31) 72 ;END 67 73 S DIK=DIE D IX^DIK 74 ;End PSA*3*7 75 ; 76 I +$P(PSADATA,"^",15)!($D(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"))) D ADJDRUG 77 I $P(PSADATA,"^",8)'="" D QTY 78 I +$P(PSADATA,"^",12) D OU 79 I +$P(PSADATA,"^",23) D PRICE 80 ;Adds the reorder level and/or dispense units per order unit 81 I +$P(PSADATA,"^",7)!(+$P(PSADATA,"^",20))!(+$P(PSADATA,"^",21))!(+$P(PSADATA,"^",27)) D 82 .S ^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSAIEN2,2)=$P(PSADATA,"^",20)_"^"_$P(PSADATA,"^",21)_"^"_$S(+$P(PSADATA,"^",7):+$P(PSADATA,"^",7),1:0)_"^"_+$P(PSADATA,"^",27) 83 ;Bgn 67 84 I $P(PSADATA,"^",5)'="" S ^XTMP("PSAVSN",$P(PSADATA,"^",5))=$P(PSADATA,"^",28)_"^"_$P(PSADATA,"^",29)_"^"_$P(PSADATA,"^",30)_"^"_$P(PSADATA,"^",31) 85 ;End 67 86 K ^XTMP("PSAPV",PSACTRL,"IT",PSALINE) 87 Q 88 ADJDRUG ;Records adjusted drug received 89 S PSAFLD="D" 90 I +$P(PSADATA,"^",15) S PSADJ=+$P(PSADATA,"^",15),PSADUZ=+$P(PSADATA,"^",16),PSADT=+$P(PSADATA,"^",17),PSAREA="" D RECORD Q 91 I $D(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")) S PSASNODE=^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"),PSADJ=$P(PSASNODE,"^",3),PSADUZ=+$P(PSASNODE,"^"),PSADT=+$P(PSASNODE,"^",2),PSAREA="" D RECORD 92 Q 93 OU ;Records adjusted order unit 94 S PSAFLD="O",PSADJ=+$P(PSADATA,"^",12),PSADUZ=+$P(PSADATA,"^",13),PSADT=+$P(PSADATA,"^",14),PSAREA="" 95 D RECORD 96 Q 97 PRICE ;Records adjusted price per order unit 98 S PSAFLD="P",PSADJ=+$P(PSADATA,"^",23),PSADUZ=+$P(PSADATA,"^",24),PSADT=+$P(PSADATA,"^",25),PSAREA="" 99 S:PSADJ'=+$P(PSADATA,"^",3) PSACRED=1 100 D RECORD 101 Q 102 QTY ;Records adjusted quantity received. 103 S PSAFLD="Q",PSADJ=+$P(PSADATA,"^",8),PSADUZ=+$P(PSADATA,"^",9),PSADT=+$P(PSADATA,"^",10),PSAREA=$P(PSADATA,"^",11) 104 S:PSADJ'=+$P(PSADATA,"^") PSACRED=1 105 D RECORD 106 Q 107 RECORD ;Adds adjusted data to DA ORDERS file 108 K DA S DA(3)=PSAIEN,DA(2)=PSAIEN1,DA(1)=PSAIEN2,X=PSAFLD 109 S:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSAIEN2,1,0)) DIC("P")=$P(^DD(58.81125,9,0),"^",2) 110 ;PSA*3*27 (DAVE B) removed killing of DA variable on next line 111 S DIC="^PSD(58.811,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,",DIC(0)="L",DLAYGO=58.811 D ^DIC S PSAIEN3=+Y K DLAYGO 112 ; 113 ;PSA*3*3 114 ;DAVEB Hard code filing 115 S DIE=DIC,DA=PSAIEN3 116 S $P(^PSD(58.811,DA(3),1,DA(2),1,DA(1),1,DA,0),"^",2)=PSADJ 117 S $P(^PSD(58.811,DA(3),1,DA(2),1,DA(1),1,DA,0),"^",3)=$G(PSAREA) 118 S $P(^PSD(58.811,DA(3),1,DA(2),1,DA(1),1,DA,0),"^",4)=DT 119 S $P(^PSD(58.811,DA(3),1,DA(2),1,DA(1),1,DA,0),"^",5)=DUZ 120 ; 121 ;S DIE=DIC,DA=PSAIEN3,DR="1///"_PSADJ_$S(PSAREA'="":";2////^S X=PSAREA",1:"")_";3///^S X="_PSADT_";4///^S X="_PSADUZ K DIC D ^DIE 122 S DIK=DIE,DA=PSAIEN3 D IX1^DIK K DA,DIE,DIK,PSAFLD 123 Q 124 ;*42 CHANGES 125 SCANDIF ; inspect invoice for noted differences in OU,DUOU,PPDU,NDC 126 ;NEEDS PSAIEN, PSAIEN1 127 K ^TMP($J,"PSADIF"),PSADIFLC 128 S PSALINE=0 F S PSALINE=$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE)) Q:PSALINE'>0 D CHECK 129 Q 130 MM ; 131 I $D(^TMP($J,"PSADIF")) D MESSAGE 132 Q 133 CHECK ;Check line item for differences to drug file *42 134 N ITM,ITMI,DRG,DRIEN,DIF,ZZ,XX,XXX,PCNT,PDIF,T,IENS 135 ; use new API call to retrieve item fields see PSAUTL6 136 D ITEM^PSAUTL6(PSAIEN,PSAIEN1,PSALINE,.ITM) 137 D ITEM^PSAUTL6(PSAIEN,PSAIEN1,PSALINE,.ITMI,"I") 138 I ITM(2)'>0 Q ;zero quantity will not be filed 139 S ITM("OU")=ITM(3),ITM("DUOU")=ITM(10),ITM("NDC")=ITM(13),ITM("PPOU")=ITM(4),ITM("PPDU")=$J(ITM("PPOU")/ITM("DUOU"),1,4) 140 S DRIEN=+ITMI(1) 141 S DRG("OU")=$$GET1^DIQ(50,DRIEN,12),DRG("DUOU")=$$GET1^DIQ(50,DRIEN,15),DRG("NDC")=$$GET1^DIQ(50,DRIEN,31),DRG("PPDU")=$$GET1^DIQ(50,DRIEN,16) 142 K DIF 143 F XX="OU","DUOU","NDC" I ITM(XX)'=DRG(XX) S DIF(XX)="" 144 I ITM("PPDU")'=DRG("PPDU") S PCNT=.05*DRG("PPDU"),PDIF=DRG("PPDU")-ITM("PPDU") S:PDIF<0 PDIF=-1*PDIF S:PDIF>PCNT DIF("PPDU")="" 145 I $D(DIF) D 146 . F ZZ=" ",$J(ITM(.01),3)_" "_ITM(1) D SET 147 . S XXX="" F S XXX=$O(DIF(XXX)) Q:XXX="" D 148 .. S ZZ=" ",T=XXX,ZZ=$$SETSTR^VALM1(T,ZZ,4,$L(T)) 149 .. S T="Old: "_DRG(XXX),ZZ=$$SETSTR^VALM1(T,ZZ,13,$L(T)) 150 .. S T="New: "_ITM(XXX),ZZ=$$SETSTR^VALM1(T,ZZ,36,$L(T)) 151 .. D SET 152 Q 153 SET ;set differences into ^TMP 154 S:'$G(PSADIFLC) PSADIFLC=3 155 S ^TMP($J,"PSADIF",PSADIFLC,0)=ZZ,PSADIFLC=PSADIFLC+1 156 Q 157 MESSAGE ;differences found, notify user and send message to g.PSA NDC UPDATES. 158 K DIR N IENS 159 S PSAORD=$$GET1^DIQ(58.811,PSAIEN,.01),IENS=PSAIEN1_","_PSAIEN 160 S PSAINV=$$GET1^DIQ(58.8112,IENS,.01) 161 S XMSUB="PRE Verify "_PSAORD_" : "_PSAINV_" Variance Report" 162 S ^TMP($J,"PSADIF",1,0)=XMSUB,^TMP($J,"PSADIF",2,0)=" " 163 W !,XMSUB,! 164 W !,"Noted differences between the invoice line items and the drug file have",!,"been found. A mail message is being sent to G.PSA NDC UPDATES." 165 W !!," Please check the message for accuracy.",! 166 K DIR S DIR(0)="E",DIR("A")="<cr> - continue" D ^DIR 167 K DIR 168 S XMTEXT="^TMP($J,""PSADIF"",",XMY("G.PSA NDC UPDATES")="" 169 D ^XMD 170 K PSADIFLC,^TMP($J,"PSADIF") 171 Q 1 PSAPROC7 ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;9/6/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,27,21,42,61,64**; 10/24/97;Build 4 3 ;This routine takes the data in XTMP and moves it to DA ORDERS file. 4 ;It deletes the data in XTMP after it is copies. 5 ; 6 ;References to ^PSDRUG( are covered by IA #2095 7 INVOICE ;PSA*3*21 (3JAN01) - FILE INVOICE IMMEDIATELY 8 ; 9 S PSAIN=$G(^XTMP("PSAPV",PSACTRL,"IN")) Q:PSAIN="" 10 Q:$P(PSAIN,"^",8)'="P" 11 S PSAORD=$P(PSAIN,"^",4),PSAIEN=+$O(^PSD(58.811,"B",PSAORD,0)),PSACRED=0 12 I 'PSAIEN D 13 .F L +^PSD(58.811,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 14 .;(PSA*3*24 - Dave B. Jun 2 00 - Improper DIC call) 15 .;(PSA*3*61 - add N DO. DICN will use DO if defined, we do not want to use it since DIC is defined. 16 .N DO S DIC="^PSD(58.811,",DIC(0)="L",X=PSAORD D FILE^DICN K DIC L -^PSD(58.811,0) S PSAIEN=+Y 17 F L +^PSD(58.811,PSAIEN,0):10 I Q 18 S:'$D(^PSD(58.811,PSAIEN,1,0)) DIC("P")=$P(^DD(58.811,2,0),"^",2) 19 S DA(1)=PSAIEN,DIC="^PSD(58.811,"_DA(1)_",1,",DIC(0)="L",X=$P(PSAIN,"^",2),DLAYGO=58.811 D ^DIC K DA,DLAYGO S PSAIEN1=+Y 20 S DA(1)=PSAIEN,DA=PSAIEN1,DIE=DIC K DIC 21 S PSALOCDR=$P($G(PSAIN),"^",7) 22 S PSADELDR=$P($G(PSAIN),"^",6) 23 S PSACSDR=$S($P(PSAIN,"^",10)="ALL CS":"A",$P(PSAIN,"^",9)="CS":"S",1:"N") 24 S PSARECD=$P($G(PSAIN),"^",11) 25 S PSAMV=$S(+$P(PSAIN,"^",12):$P(PSAIN,"^",12),1:"") 26 S PSASUP=$S($P(PSAIN,"^",13)="SUP":1,1:"") 27 ;DAVE B ( PSA*3*12) Invalid Concatenation of zero node 28 S ^PSD(58.811,DA(1),1,DA,0)=$P(^(0),"^")_"^"_$P(PSAIN,"^",1)_"^P^"_$P(PSAIN,"^",3)_"^"_$G(PSALOCDR)_"^"_$G(PSADELDR)_"^"_$G(PSARECD)_"^"_$G(PSACSDR)_"^^"_DUZ_"^^"_$G(PSAMV)_"^"_$G(PSASUP) 29 S DIK=DIE D IX^DIK 30 K ^TMP($J,"PSADIF"),PSADIFLC ;*42 pre verify storage for OU, DUOU, Cost, NDC changes 31 S PSALINE=0 F S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:PSALINE="" D LINE 32 D SCANDIF,MM ;*42 look for differences to drug file SEND EMAIL 33 I PSACRED K DA S DA(1)=PSAIEN,DA=PSAIEN1,DIE="^PSD(58.811,"_DA(1)_",1,",DR="10///^S X=1" D ^DIE K DIE 34 S $P(^PSD(58.811,PSAIEN,0),"^",2)=$P($G(^XTMP("PSAPV",PSACTRL,"DS")),"^") 35 L -^PSD(58.811,PSAIEN,0) 36 K ^XTMP("PSAPV",PSACTRL) 37 Q 38 ; 39 LINE ;Files line items. 40 S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE) S:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,0)) DIC("P")=$P(^DD(58.8112,5,0),"^",2) 41 ;PSA*3*31 Dave B - Check for invoice already in file 42 S DA(2)=PSAIEN,DA(1)=PSAIEN1,(DA,X)=PSALINE,DIC="^PSD(58.811,"_DA(2)_",1,"_DA(1)_",1,",DIC(0)="L",DLAYGO=58.811 D ^DIC S PSAIEN2=+Y K DA,DIC,DLAYGO 43 ; 44 ;DAVEB PSA*3*3 (5may98) 45 S PSADRG=$P($G(PSADATA),"^",6) 46 S PSASYN=$P($G(PSADATA),"^",7) 47 K PSAUNIT 48 I $G(PSASYN)'="",$G(PSADRG)'="" S PSAUNIT=+$P($G(^PSDRUG(PSADRG,1,PSASYN,0)),"^",5) 49 ; 50 ;DAVE B (PSA*3*12) Assignment of order unit didn't take into 51 ;account the adjusted order unit. 52 S PSAUNIT=$S($D(PSAUNIT):PSAUNIT,$P(PSADATA,"^",12)'="":$P(PSADATA,"^",12),+$P($P(PSADATA,"^",2),"~",2):+$P($P(PSADATA,"^",2),"~",2),1:0) 53 S PSACS=$S($P(PSADATA,"^",19)="CS":1,1:0),PSANDC=$P($P(PSADATA,"^",4),"~"),PSAVSN=$P($P(PSADATA,"^",5),"~"),PSAUPC=$P($P(PSADATA,"^",26),"~") 54 I PSANDC="",$P($P(PSADATA,"^",26),"~")'="" S PSANDC="S"_$P($P(PSADATA,"^",26),"~") 55 S DA(2)=PSAIEN,DA(1)=PSAIEN1,DA=$S($D(PSAIEN2):PSAIEN2,1:PSALINE),DIE="^PSD(58.811,"_DA(2)_",1,"_DA(1)_",1," 56 ;DaveB (4may98) hard code filing data 57 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",3)=+PSADATA 58 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",11)=PSANDC 59 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",12)=PSAVSN 60 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",13)=PSAUPC 61 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",10)=PSACS 62 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",2)=PSADRG 63 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",4)=PSAUNIT 64 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",5)=$P(PSADATA,"^",3) 65 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",6)=DT 66 S $P(^PSD(58.811,DA(2),1,DA(1),1,DA,0),"^",7)=DUZ 67 S DIK=DIE D IX^DIK 68 ;End PSA*3*7 69 ; 70 I +$P(PSADATA,"^",15)!($D(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"))) D ADJDRUG 71 I $P(PSADATA,"^",8)'="" D QTY 72 I +$P(PSADATA,"^",12) D OU 73 I +$P(PSADATA,"^",23) D PRICE 74 ;Adds the reorder level and/or dispense units per order unit 75 I +$P(PSADATA,"^",7)!(+$P(PSADATA,"^",20))!(+$P(PSADATA,"^",21))!(+$P(PSADATA,"^",27)) D 76 .S ^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSAIEN2,2)=$P(PSADATA,"^",20)_"^"_$P(PSADATA,"^",21)_"^"_$S(+$P(PSADATA,"^",7):+$P(PSADATA,"^",7),1:0)_"^"_+$P(PSADATA,"^",27) 77 K ^XTMP("PSAPV",PSACTRL,"IT",PSALINE) 78 Q 79 ADJDRUG ;Records adjusted drug received 80 S PSAFLD="D" 81 I +$P(PSADATA,"^",15) S PSADJ=+$P(PSADATA,"^",15),PSADUZ=+$P(PSADATA,"^",16),PSADT=+$P(PSADATA,"^",17),PSAREA="" D RECORD Q 82 I $D(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")) S PSASNODE=^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"),PSADJ=$P(PSASNODE,"^",3),PSADUZ=+$P(PSASNODE,"^"),PSADT=+$P(PSASNODE,"^",2),PSAREA="" D RECORD 83 Q 84 OU ;Records adjusted order unit 85 S PSAFLD="O",PSADJ=+$P(PSADATA,"^",12),PSADUZ=+$P(PSADATA,"^",13),PSADT=+$P(PSADATA,"^",14),PSAREA="" 86 D RECORD 87 Q 88 PRICE ;Records adjusted price per order unit 89 S PSAFLD="P",PSADJ=+$P(PSADATA,"^",23),PSADUZ=+$P(PSADATA,"^",24),PSADT=+$P(PSADATA,"^",25),PSAREA="" 90 S:PSADJ'=+$P(PSADATA,"^",3) PSACRED=1 91 D RECORD 92 Q 93 QTY ;Records adjusted quantity received. 94 S PSAFLD="Q",PSADJ=+$P(PSADATA,"^",8),PSADUZ=+$P(PSADATA,"^",9),PSADT=+$P(PSADATA,"^",10),PSAREA=$P(PSADATA,"^",11) 95 S:PSADJ'=+$P(PSADATA,"^") PSACRED=1 96 D RECORD 97 Q 98 RECORD ;Adds adjusted data to DA ORDERS file 99 K DA S DA(3)=PSAIEN,DA(2)=PSAIEN1,DA(1)=PSAIEN2,X=PSAFLD 100 S:'$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSAIEN2,1,0)) DIC("P")=$P(^DD(58.81125,9,0),"^",2) 101 ;PSA*3*27 (DAVE B) removed killing of DA variable on next line 102 S DIC="^PSD(58.811,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,",DIC(0)="L",DLAYGO=58.811 D ^DIC S PSAIEN3=+Y K DLAYGO 103 ; 104 ;PSA*3*3 105 ;DAVEB Hard code filing 106 S DIE=DIC,DA=PSAIEN3 107 S $P(^PSD(58.811,DA(3),1,DA(2),1,DA(1),1,DA,0),"^",2)=PSADJ 108 S $P(^PSD(58.811,DA(3),1,DA(2),1,DA(1),1,DA,0),"^",3)=$G(PSAREA) 109 S $P(^PSD(58.811,DA(3),1,DA(2),1,DA(1),1,DA,0),"^",4)=DT 110 S $P(^PSD(58.811,DA(3),1,DA(2),1,DA(1),1,DA,0),"^",5)=DUZ 111 ; 112 ;S DIE=DIC,DA=PSAIEN3,DR="1///"_PSADJ_$S(PSAREA'="":";2////^S X=PSAREA",1:"")_";3///^S X="_PSADT_";4///^S X="_PSADUZ K DIC D ^DIE 113 S DIK=DIE,DA=PSAIEN3 D IX1^DIK K DA,DIE,DIK,PSAFLD 114 Q 115 ;*42 CHANGES 116 SCANDIF ; inspect invoice for noted differences in OU,DUOU,PPDU,NDC 117 ;NEEDS PSAIEN, PSAIEN1 118 K ^TMP($J,"PSADIF"),PSADIFLC 119 S PSALINE=0 F S PSALINE=$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE)) Q:PSALINE'>0 D CHECK 120 Q 121 MM ; 122 I $D(^TMP($J,"PSADIF")) D MESSAGE 123 Q 124 CHECK ;Check line item for differences to drug file *42 125 N ITM,ITMI,DRG,DRIEN,DIF,ZZ,XX,XXX,PCNT,PDIF,T,IENS 126 ; use new API call to retrieve item fields see PSAUTL6 127 D ITEM^PSAUTL6(PSAIEN,PSAIEN1,PSALINE,.ITM) 128 D ITEM^PSAUTL6(PSAIEN,PSAIEN1,PSALINE,.ITMI,"I") 129 I ITM(2)'>0 Q ;zero quantity will not be filed 130 S ITM("OU")=ITM(3),ITM("DUOU")=ITM(10),ITM("NDC")=ITM(13),ITM("PPOU")=ITM(4),ITM("PPDU")=$J(ITM("PPOU")/ITM("DUOU"),1,4) 131 S DRIEN=+ITMI(1) 132 S DRG("OU")=$$GET1^DIQ(50,DRIEN,12),DRG("DUOU")=$$GET1^DIQ(50,DRIEN,15),DRG("NDC")=$$GET1^DIQ(50,DRIEN,31),DRG("PPDU")=$$GET1^DIQ(50,DRIEN,16) 133 K DIF 134 F XX="OU","DUOU","NDC" I ITM(XX)'=DRG(XX) S DIF(XX)="" 135 I ITM("PPDU")'=DRG("PPDU") S PCNT=.05*DRG("PPDU"),PDIF=DRG("PPDU")-ITM("PPDU") S:PDIF<0 PDIF=-1*PDIF S:PDIF>PCNT DIF("PPDU")="" 136 I $D(DIF) D 137 . F ZZ=" ",$J(ITM(.01),3)_" "_ITM(1) D SET 138 . S XXX="" F S XXX=$O(DIF(XXX)) Q:XXX="" D 139 .. S ZZ=" ",T=XXX,ZZ=$$SETSTR^VALM1(T,ZZ,4,$L(T)) 140 .. S T="Old: "_DRG(XXX),ZZ=$$SETSTR^VALM1(T,ZZ,13,$L(T)) 141 .. S T="New: "_ITM(XXX),ZZ=$$SETSTR^VALM1(T,ZZ,36,$L(T)) 142 .. D SET 143 Q 144 SET ;set differences into ^TMP 145 S:'$G(PSADIFLC) PSADIFLC=3 146 S ^TMP($J,"PSADIF",PSADIFLC,0)=ZZ,PSADIFLC=PSADIFLC+1 147 Q 148 MESSAGE ;differences found, notify user and send message to g.PSA NDC UPDATES. 149 K DIR N IENS 150 S PSAORD=$$GET1^DIQ(58.811,PSAIEN,.01),IENS=PSAIEN1_","_PSAIEN 151 S PSAINV=$$GET1^DIQ(58.8112,IENS,.01) 152 S XMSUB="PRE Verify "_PSAORD_" : "_PSAINV_" Variance Report" 153 S ^TMP($J,"PSADIF",1,0)=XMSUB,^TMP($J,"PSADIF",2,0)=" " 154 W !,XMSUB,! 155 W !,"Noted differences between the invoice line items and the drug file have",!,"been found. A mail message is being sent to G.PSA NDC UPDATES." 156 W !!," Please check the message for accuracy.",! 157 K DIR S DIR(0)="E",DIR("A")="<cr> - continue" D ^DIR 158 K DIR 159 S XMTEXT="^TMP($J,""PSADIF"",",XMY("G.PSA NDC UPDATES")="" 160 D ^XMD 161 K PSADIFLC,^TMP($J,"PSADIF") 162 Q
Note:
See TracChangeset
for help on using the changeset viewer.
