| [613] | 1 | RMPR4UTL ;PHX/HNB - PURCHASE CARD MODULE ;3/1/1996
|
|---|
| 2 | ;;3.0;PROSTHETICS;**3,12,20,25,30,44,41**;Feb 09, 1996
|
|---|
| 3 | Q
|
|---|
| 4 | EDT ;Edit Purchase Card
|
|---|
| 5 | S HY=+Y I '$D(^RMPR(664,RMPRA,1)) S ^RMPR(664,RMPRA,1,0)="^664.02PA^0^0" G FILE
|
|---|
| 6 | I $D(^RMPR(664,RMPRA,1,"B",+Y)) S DA=$O(^RMPR(664,RMPRA,1,"B",+Y,0)) G CHK
|
|---|
| 7 | FILE S Y=HY,NUM=$P(^RMPR(664,RMPRA,1,0),U,4)+1,$P(^(0),U,4)=NUM,$P(^(0),U,3)=$P(^(0),U,3)+1,^RMPR(664,RMPRA,1,NUM,0)=+Y,DA=NUM,^RMPR(664,RMPRA,1,"B",+Y,NUM)="" S NEW=1
|
|---|
| 8 | ENT K DR,DQ S DA(1)=RMPRA,DIE="^RMPR(664,"_RMPRA_",1," ;S DR=$S($D(NEW):"",1:".01;") K NEW
|
|---|
| 9 | S DR="17;16;8////^S X=$G(RMTYPE);9////^S X=$G(RMCAT);10////^S X=$G(RMSPE);1R~BRIEF DESCRIPTION OF ITEM (for Vendor);"
|
|---|
| 10 | S DR=DR_"14;3;2;4R;11////C;7"
|
|---|
| 11 | D ^DIE Q:$D(DTOUT) K NUM,DA,NEW,Y,DR Q
|
|---|
| 12 | NFRM S DR=DR_"17;8TYPE OF TRANSACTION;9PATIENT CATEGORY;S RMPRDIS=+$P(^RMPR(664,DA(1),1,DA,0),U,10);S Y=$S(RMPRDIS=4:""@1"",1:""@2"");@2;3QTY;2;4UNIT OF ISSUE;11////C;"
|
|---|
| 13 | S DR=DR_"7REMARKS;S Y="""";@1;10SPECIAL CATEGORY;S Y=""@2"";"
|
|---|
| 14 | D ^DIE K NUM,DA,NEW,Y,DR
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | SS ;add IFCAP Site Parameter
|
|---|
| 18 | D DIV4^RMPRSIT Q:$D(X)
|
|---|
| 19 | W !!,?5,"Enter the IFCAP Site used with the Purchase Card Module"
|
|---|
| 20 | W !,?5,"The following site you select will be used on all your"
|
|---|
| 21 | W !,?5,"Purchase Card Transactions in IFCAP only.",!
|
|---|
| 22 | D ^PRCFSITE
|
|---|
| 23 | S:$G(PRC("SITE"))'="" $P(^RMPR(669.9,RMPRSITE,4),U,1)=PRC("SITE")
|
|---|
| 24 | D KILL^XUSCLEAN
|
|---|
| 25 | Q
|
|---|
| 26 | CHK ;Add Duplicate Item
|
|---|
| 27 | K DIR,Y S DIR(0)="S^Y:YES;N:NO",DIR("A")="DO YOU WANT TO ADD A DUPLICATE ITEM?",DIR("B")="NO" D ^DIR Q:$D(DIRUT)!($D(DTOUT)) I X["Y"!(X["y") G FILE
|
|---|
| 28 | S RD=0 F RDA=0:0 S RDA=$O(^RMPR(664,RMPRA,1,"B",HY,RDA)) Q:RDA'>0 S RD=RD+1
|
|---|
| 29 | LKP ;DISPLAY DUPLICATE AND SINGLE ITEMS
|
|---|
| 30 | I RD>1 D Q:$D(DIRUT)!$D(DTOUT) I '$D(RD(+Y)) W $C(7) G LKP
|
|---|
| 31 | .F RDA=0:0 S RDA=$O(^RMPR(664,RMPRA,1,"B",HY,RDA)) Q:RDA'>0 S RD(RDA)=^RMPR(664,RMPRA,1,RDA,0) W !?5,RDA,?10,$P(^PRC(441,$P(^RMPR(661,$P(RD(RDA),U),0),U),0),U,2)," $",$P(RD(RDA),U,3)
|
|---|
| 32 | .K DIR,Y S DIR(0)="N" D ^DIR I +Y S DA=+Y
|
|---|
| 33 | G ENT
|
|---|
| 34 | ;
|
|---|
| 35 | CHKCPT(RDATA) ;check for cpt modifier, change of Type of Transaction.
|
|---|
| 36 | ;
|
|---|
| 37 | N RMHCPC,RMCPT,RMCI,RMC,RMCLEN,RMLPIECE,RMF,RMFPIECE,RMTYPE,RMPRA,R4DA
|
|---|
| 38 | S RMTYPE=$P(RDATA,U,1),RMPRA=$P(RDATA,U,2),R4DA=$P(RDATA,U,3)
|
|---|
| 39 | Q:'$D(^RMPR(664,RMPRA,1,R4DA))
|
|---|
| 40 | S RMHCPC=$P($G(^RMPR(664,RMPRA,1,R4DA,0)),U,16) Q:'$G(RMHCPC)
|
|---|
| 41 | S RMCPT=$P($G(^RMPR(664,RMPRA,1,R4DA,4)),U,2)
|
|---|
| 42 | I ((RMTYPE="R")!(RMTYPE="X")),(RMCPT'["RP"),($G(^RMPR(661.1,RMHCPC,4))["RP") D ADDRP
|
|---|
| 43 | I ((RMTYPE="I")!(RMTYPE="S")),(RMCPT["RP") D DELRP
|
|---|
| 44 | K RMHCPC,RMCI,RMC,RMCLEN,RMLPIECE,RMF,RMFPIECE,RMTYPE,RMPRA,R4DA
|
|---|
| 45 | Q
|
|---|
| 46 | ;return to (PC) close out option
|
|---|
| 47 | DELRP ;logic for deleting 'RP' modifier with transaction change.
|
|---|
| 48 | F RMCI=1:1:8 S RMC=$P(RMCPT,",",RMCI) I RMC="RP" S $P(RMCPT,",",RMCI)="" D
|
|---|
| 49 | .S RMF=$F(RMCPT,",,"),RMFPIECE=$E(RMCPT,1,RMF-2)
|
|---|
| 50 | .S RMLPIECE=$E(RMCPT,RMF,32),RMCPT=RMFPIECE_RMLPIECE
|
|---|
| 51 | .S RMCLEN=$L(RMCPT)
|
|---|
| 52 | .I $E(RMCPT,1)="," S RMCPT=$E(RMCPT,2,RMCLEN)
|
|---|
| 53 | .I $E(RMCPT,RMCLEN)="," S RMCPT=$E(RMCPT,1,RMCLEN-1)
|
|---|
| 54 | .S $P(^RMPR(664,RMPRA,1,R4DA,4),U,2)=RMCPT
|
|---|
| 55 | ;
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | ADDRP ;logic for adding 'RP' modifier with transaction change.
|
|---|
| 59 | S RMCPT=RMCPT_",RP" S $P(^RMPR(664,RMPRA,1,R4DA,4),U,2)=RMCPT
|
|---|
| 60 | Q
|
|---|
| 61 | ;end
|
|---|
