Changeset 623 for WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAVER7.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAVER7.m
r613 r623 1 PSAVER7 ;BIR/JMB-Verify Invoices - CONT'D ;7/23/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**12,21,42,56,64,66**; 10/24/97;Build 2 3 ;Background Job 4 ;This routine increments pharmacy location and master vault balances 5 ;in 58.8 after invoices have been verified. This routine is called 6 ;by PSAVER6. 7 ; 8 ;References to ^PSDRUG( are covered by IA #2095 9 TR ;File transaction data in 58.81 10 I $D(PSADUREC),'PSADUREC Q ;*56 block '0' quantity edits 11 I $D(PSAQTY),'PSAQTY Q ;*56 block '0' quantity edits 12 F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 13 FIND S PSAT=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSAT)) S $P(^PSD(58.81,0),"^",3)=$P(^PSD(58.81,0),"^",3)+1 G FIND 14 S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSAT D ^DIC K DIC,DINUM,DLAYGO L -^PSD(58.81,0) 15 S DIE="^PSD(58.81,",DA=PSAT,DR="1////1;2////^S X=PSALOC;3////^S X=PSADT;4////^S X=PSADRG;5////^S X=PSADUREC;6////^S X=PSAVDUZ;9////^S X=PSABAL;71////^S X=PSAINV;106////^S X=PSAORD" 16 I $G(PSACS) S DR=DR_";100////^S X=PSACS" 17 F L +^PSD(58.81,DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 18 D ^DIE L -^PSD(58.81,DA,0) K DIE 19 S:'$D(^PSD(58.8,PSALOC,1,PSADRG,4,0)) DIC("P")=$P(^DD(58.8001,19,0),"^",2) 20 S DA(2)=PSALOC,DA(1)=PSADRG,(X,DINUM)=PSAT,DIC="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",4,",DIC(0)="L",DLAYGO=58.8 21 F L +^PSD(58.8,PSALOC,1,PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 22 D ^DIC L -^PSD(58.8,PSALOC,1,PSADRG,0) K DIC,DINUM,DLAYGO 23 ; 24 50 S PSAODASH=$P($G(^PSDRUG(PSADRG,2)),"^",4) 25 S PSAONDC=$P(PSAODASH,"-")_$P(PSAODASH,"-",2)_$P(PSAODASH,"-",3) 26 ;(PSA*3*21) NDC & PRICING UPDATES (DAVE BLOCKER 10NOV99) 27 S PSADUOU=$S($G(PSADUOU)'>0:1,1:PSADUOU) 28 S PSADUREC=(PSAQTY*PSADUOU) 29 S DIE="^PSDRUG(",DA=PSADRG,DR="50////^S X="_(PSADUREC+$G(^PSDRUG(PSADRG,660.1))) 30 F L +^PSDRUG(DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 31 D ^DIE L -^PSDRUG(DA,0) K DIE,DA,DR 32 ;This section replaces most of the routine 33 ;PSAOU = order unit from invoice 34 ;PSAPOU & PSANPOU = Price of Order Unit from invoice 35 ;PSADUOU=Dispense Units per OU form invoice data 36 ;PSANPDU= Price of Dispense Units per Order Unit 37 ; 38 ;Drug file Information 39 K DRUG 40 S PSANODE=$G(^PSDRUG(PSADRG,660)) 41 F X=2,3,5,6 S DRUG(X)=$P($G(PSANODE),"^",X) 42 ; 43 S PSANPDU=$J(($G(PSAPOU)/$G(PSADUOU)),0,3) ;Price of Order Unit divide by Disp. Units per Order Unit 44 ;PSA*3*42 |> (let changes happen and file, put changes into mail message) 45 S DIE="^PSDRUG(",(DA,OLDDA)=PSADRG,DR="12////^S X=PSAOU;15////^S X=PSADUOU;Q;13////^S X=PSAPOU" ;*42;*56 46 F L +^PSDRUG(DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 47 D ^DIE K DIE,DA,DR 48 ; <| PSA*42 49 PTCH21 ;PSA*3*21 (Vendor's VSN changing to 8 digits, check also) 50 ;If NDC or VSN changes should it create to synonym entry ? 51 I $G(^PSDRUG(PSADRG,1,PSASUB,0))="" G NDC 52 I $G(^PSDRUG(PSADRG,1,PSASUB,0)) S PSAEDTT=0,DATA=^PSDRUG(PSADRG,1,PSASUB,0) D 53 .I PSAVSN'=$P(DATA,"^",4) S PSAEDTT=1 ;VSN 54 .I PSAPOU'=$P(DATA,"^",6) S PSAEDTT=1 ;Price per order unit 55 .I PSADUOU'=$P(DATA,"^",7) S PSAEDTT=1 ;Dispense Units per Order Unit 56 .I PSANPDU'=$P(DATA,"^",8) S PSAEDTT=1 ;New Price per dispense unit 57 .I $G(PSAEDTT)>0 D 58 ..S DA=PSASUB,DA(1)=PSADRG,DIE="^PSDRUG("_DA(1)_",1," 59 ..S DR="2////^S X=PSADASH"_$S(PSACS:";1////C",1:";1////D")_";400////^S X=PSAVSN;401////^S X=PSAOU"_$S(+PSAPOU:";402////^S X=PSAPOU",1:"")_";403////^S X=PSADUOU"_";404///^S X=PSANPDU"_";405///^S X=PSAVEND" 60 ..D ^DIE K DIE,DR,DA 61 NDC ;NDC UPDATE 62 I PSANDC'="",PSANDC'=PSAONDC D ;*42 63 .S DIE="^PSDRUG(",DA=PSADRG,DR="31////^S X=PSADASH" 64 .F L +^PSDRUG(DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 65 .D ^DIE L -^PSDRUG(DA,0) K DIE,DA,DR 66 SYNONYM ;Adds/edits the SYNONYM multiple in DRUG file >>*66 RJS 67 G:PSANDC="" END 68 S DA(1)=PSADRG ;; << *66 RJS 69 ; 70 S PSANPDU=$J(($G(PSAPOU)/$G(PSADUOU)),0,3) ;Price of Order Unit divide by Disp. Units per Order Unit 71 S:'$D(^PSDRUG(PSADRG,1,0)) DIC("P")="50.1A" 72 ; *56 Search for earliest best match of synonyms, start at bottom go up 73 ; if VSN use it, if several VSNs use the first, IF VSN match NDCs must match also. 74 ; if no VSN, make a new synonym 75 ; no "B" synonym index exists 76 T0 N PSYNDA,PSYN0,PSTNDC,PSTVSN,PSMNDC,PSMBTH S (PSMNDC,PSMBTH)=0 77 S PSYNDA="" F S PSYNDA=$O(^PSDRUG(PSADRG,1,PSYNDA),-1) Q:PSYNDA'>0 D 78 . S PSYN0=^PSDRUG(PSADRG,1,PSYNDA,0),PSTNDC=$P(PSYN0,U),PSTVSN=$P(PSYN0,U,4) ;zero node, test values of NDC VSN 79 . I PSTNDC'=PSANDC Q 80 . I PSTVSN=PSAVSN S PSMBTH=PSYNDA Q ;both VSN & NDC matches 81 T1 S PSASUB=$S(PSMBTH:PSMBTH,1:0) ;PSAMBTH Match both vsn,ndc 82 ;end *56 83 I 'PSASUB!(PSASUB&('$D(^PSDRUG(PSADRG,1,PSASUB,0)))) D 84 .S DIC="^PSDRUG("_DA(1)_",1,",DIC(0)="Z",X=PSANDC,DLAYGO=50 85 .F L +^PSDRUG(PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 86 .D FILE^DICN L -^PSDRUG(PSADRG,0) K DIC,DLAYGO S PSASUB=+Y 87 .K DIC,DA,DR,DIE 88 I PSASUB,$D(^PSDRUG(PSADRG,1,PSASUB,0)) S DA=PSASUB 89 S DA(1)=PSADRG,DIE="^PSDRUG("_DA(1)_",1," 90 S DR="2////^S X=PSADASH"_$S($G(PSACS)>0:";1////C",1:";1////D")_";400////^S X=PSAVSN;401////^S X=PSAOU"_$S(+PSAPOU:";402////^S X=PSAPOU",1:"")_";403////^S X=PSADUOU"_";404///^S X=PSANPDU;405///^S X=PSAVEND" 91 F L +^PSDRUG(PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 92 D ^DIE L -^PSDRUG(PSADRG,0) 93 K DIE,DR,X1,X2,DATA 94 END ; FINAL CLEANUP << *66 RJS 95 L -^PSDRUG(OLDDA,0) K OLDDA ;; >> *66 RJS 96 Q 1 PSAVER7 ;BIR/JMB-Verify Invoices - CONT'D ;7/23/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**12,21,42,56,64**; 10/24/97;Build 4 3 ;Background Job 4 ;This routine increments pharmacy location and master vault balances 5 ;in 58.8 after invoices have been verified. This routine is called 6 ;by PSAVER6. 7 ; 8 ;References to ^PSDRUG( are covered by IA #2095 9 TR ;File transaction data in 58.81 10 I $D(PSADUREC),'PSADUREC Q ;*56 block '0' quantity edits 11 I $D(PSAQTY),'PSAQTY Q ;*56 block '0' quantity edits 12 F L +^PSD(58.81,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 13 FIND S PSAT=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSAT)) S $P(^PSD(58.81,0),"^",3)=$P(^PSD(58.81,0),"^",3)+1 G FIND 14 S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSAT D ^DIC K DIC,DINUM,DLAYGO L -^PSD(58.81,0) 15 S DIE="^PSD(58.81,",DA=PSAT,DR="1////1;2////^S X=PSALOC;3////^S X=PSADT;4////^S X=PSADRG;5////^S X=PSADUREC;6////^S X=PSAVDUZ;9////^S X=PSABAL;71////^S X=PSAINV;106////^S X=PSAORD" 16 I $G(PSACS) S DR=DR_";100////^S X=PSACS" 17 F L +^PSD(58.81,DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 18 D ^DIE L -^PSD(58.81,DA,0) K DIE 19 S:'$D(^PSD(58.8,PSALOC,1,PSADRG,4,0)) DIC("P")=$P(^DD(58.8001,19,0),"^",2) 20 S DA(2)=PSALOC,DA(1)=PSADRG,(X,DINUM)=PSAT,DIC="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",4,",DIC(0)="L",DLAYGO=58.8 21 F L +^PSD(58.8,PSALOC,1,PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 22 D ^DIC L -^PSD(58.8,PSALOC,1,PSADRG,0) K DIC,DINUM,DLAYGO 23 ; 24 50 S PSAODASH=$P($G(^PSDRUG(PSADRG,2)),"^",4) 25 S PSAONDC=$P(PSAODASH,"-")_$P(PSAODASH,"-",2)_$P(PSAODASH,"-",3) 26 ;(PSA*3*21) NDC & PRICING UPDATES (DAVE BLOCKER 10NOV99) 27 S PSADUOU=$S($G(PSADUOU)'>0:1,1:PSADUOU) 28 S PSADUREC=(PSAQTY*PSADUOU) 29 S DIE="^PSDRUG(",DA=PSADRG,DR="50////^S X="_(PSADUREC+$G(^PSDRUG(PSADRG,660.1))) 30 F L +^PSDRUG(DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 31 D ^DIE L -^PSDRUG(DA,0) K DIE,DA,DR 32 ;This section replaces most of the routine 33 ;PSAOU = order unit from invoice 34 ;PSAPOU & PSANPOU = Price of Order Unit from invoice 35 ;PSADUOU=Dispense Units per OU form invoice data 36 ;PSANPDU= Price of Dispense Units per Order Unit 37 ; 38 ;Drug file Information 39 K DRUG 40 S PSANODE=$G(^PSDRUG(PSADRG,660)) 41 F X=2,3,5,6 S DRUG(X)=$P($G(PSANODE),"^",X) 42 ; 43 S PSANPDU=$J(($G(PSAPOU)/$G(PSADUOU)),0,3) ;Price of Order Unit divide by Disp. Units per Order Unit 44 ;PSA*3*42 |> (let changes happen and file, put changes into mail message) 45 S DIE="^PSDRUG(",DA=PSADRG,DR="12////^S X=PSAOU;15////^S X=PSADUOU;Q;13////^S X=PSAPOU" ;*42;*56 46 F L +^PSDRUG(DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 47 D ^DIE K DIE,DA,DR 48 ; <| PSA*42 49 PTCH21 ;PSA*3*21 (Vendor's VSN changing to 8 digits, check also) 50 ;If NDC or VSN changes should it create to synonym entry ? 51 I $G(^PSDRUG(PSADRG,1,PSASUB,0))="" G NDC 52 I $G(^PSDRUG(PSADRG,1,PSASUB,0)) S PSAEDTT=0,DATA=^PSDRUG(PSADRG,1,PSASUB,0) D 53 .I PSAVSN'=$P(DATA,"^",4) S PSAEDTT=1 ;VSN 54 .I PSAPOU'=$P(DATA,"^",6) S PSAEDTT=1 ;Price per order unit 55 .I PSADUOU'=$P(DATA,"^",7) S PSAEDTT=1 ;Dispense Units per Order Unit 56 .I PSANPDU'=$P(DATA,"^",8) S PSAEDTT=1 ;New Price per dispense unit 57 .I $G(PSAEDTT)>0 D 58 ..S DA=PSASUB,DA(1)=PSADRG,DIE="^PSDRUG("_DA(1)_",1," 59 ..S DR="2////^S X=PSADASH"_$S(PSACS:";1////C",1:";1////D")_";400////^S X=PSAVSN;401////^S X=PSAOU"_$S(+PSAPOU:";402////^S X=PSAPOU",1:"")_";403////^S X=PSADUOU"_";404///^S X=PSANPDU"_";405///^S X=PSAVEND" 60 ..D ^DIE K DIE,DR,DA 61 NDC ;NDC UPDATE 62 I PSANDC'="",PSANDC'=PSAONDC D ;*42 63 .S DIE="^PSDRUG(",DA=PSADRG,DR="31////^S X=PSADASH" 64 .F L +^PSDRUG(DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 65 .D ^DIE L -^PSDRUG(DA,0) K DIE,DA,DR 66 SYNONYM ;Adds/edits the SYNONYM multiple in DRUG file 67 Q:PSANDC="" K DA,DR S DA(1)=PSADRG 68 ; 69 S PSANPDU=$J(($G(PSAPOU)/$G(PSADUOU)),0,3) ;Price of Order Unit divide by Disp. Units per Order Unit 70 S:'$D(^PSDRUG(PSADRG,1,0)) DIC("P")="50.1A" 71 ; *56 Search for earliest best match of synonyms, start at bottom go up 72 ; if VSN use it, if several VSNs use the first, IF VSN match NDCs must match also. 73 ; if no VSN, make a new synonym 74 ; no "B" synonym index exists 75 T0 N PSYNDA,PSYN0,PSTNDC,PSTVSN,PSMNDC,PSMBTH S (PSMNDC,PSMBTH)=0 76 S PSYNDA="" F S PSYNDA=$O(^PSDRUG(PSADRG,1,PSYNDA),-1) Q:PSYNDA'>0 D 77 . S PSYN0=^PSDRUG(PSADRG,1,PSYNDA,0),PSTNDC=$P(PSYN0,U),PSTVSN=$P(PSYN0,U,4) ;zero node, test values of NDC VSN 78 . I PSTNDC'=PSANDC Q 79 . I PSTVSN=PSAVSN S PSMBTH=PSYNDA Q ;both VSN & NDC matches 80 T1 S PSASUB=$S(PSMBTH:PSMBTH,1:0) ;PSAMBTH Match both vsn,ndc 81 ;end *56 82 I 'PSASUB!(PSASUB&('$D(^PSDRUG(PSADRG,1,PSASUB,0)))) D 83 .S DIC="^PSDRUG("_DA(1)_",1,",DIC(0)="Z",X=PSANDC,DLAYGO=50 84 .F L +^PSDRUG(PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 85 .D FILE^DICN L -^PSDRUG(PSADRG,0) K DIC,DLAYGO S PSASUB=+Y 86 .K DIC,DA,DR,DIE 87 I PSASUB,$D(^PSDRUG(PSADRG,1,PSASUB,0)) S DA=PSASUB 88 S DA(1)=PSADRG,DIE="^PSDRUG("_DA(1)_",1," 89 S DR="2////^S X=PSADASH"_$S($G(PSACS)>0:";1////C",1:";1////D")_";400////^S X=PSAVSN;401////^S X=PSAOU"_$S(+PSAPOU:";402////^S X=PSAPOU",1:"")_";403////^S X=PSADUOU"_";404///^S X=PSANPDU;405///^S X=PSAVEND" 90 F L +^PSDRUG(PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q 91 D ^DIE L -^PSDRUG(PSADRG,0) 92 K DIE,DR,X1,X2,DATA 93 Q
Note:
See TracChangeset
for help on using the changeset viewer.
