| 1 | PRCPUPAT ;WISC/RFJ-move item from prim to seco to patient ;09 Mar 94
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | PATIENT(PATDFN,SURGDA) ; create patient distribution entry for patdfn
|
|---|
| 8 | ; return entry created
|
|---|
| 9 | N %,%H,%I,DA,X,Y
|
|---|
| 10 | I 'PATDFN Q 0
|
|---|
| 11 | D NOW^%DTC
|
|---|
| 12 | S DA=$$ADD(%,PATDFN)
|
|---|
| 13 | I SURGDA D SURGERY(DA,SURGDA)
|
|---|
| 14 | Q DA
|
|---|
| 15 | ;
|
|---|
| 16 | ;
|
|---|
| 17 | SURGERY(DA,SURGDA) ; update distribution with surgery data
|
|---|
| 18 | I '$D(^PRCP(446.1,DA,0)) Q
|
|---|
| 19 | N %,D0,DI,DIC,DIE,DQ,DR,OPCODE,OPROOM,PRCPSDAT,SURGDATA,SURGEON,SURGSPEC,X,Y
|
|---|
| 20 | ; get surgery data
|
|---|
| 21 | D SURGDATA^PRCPCRPL(SURGDA,".01;.011;.02;.04;.14;27")
|
|---|
| 22 | I '$D(PRCPSDAT(130,SURGDA,.01,"I")) Q
|
|---|
| 23 | ;
|
|---|
| 24 | S DR="1///S;2///`"_PRCPSDAT(130,SURGDA,.01,"I")_";"
|
|---|
| 25 | ; operating room
|
|---|
| 26 | S OPROOM=+$G(PRCPSDAT(130,SURGDA,.02,"I")) I OPROOM S DR=DR_"130.02///`"_OPROOM_";"
|
|---|
| 27 | ; surgical specialty
|
|---|
| 28 | S SURGSPEC=$G(PRCPSDAT(130,SURGDA,.04,"I")) I SURGSPEC S DR=DR_"130.03///`"_SURGSPEC_";"
|
|---|
| 29 | ; inpatient/outpatient
|
|---|
| 30 | I $D(PRCPSDAT(130,SURGDA,.011,"E")) S DR=DR_"3///"_PRCPSDAT(130,SURGDA,.011,"E")_";"
|
|---|
| 31 | ; surgeon
|
|---|
| 32 | S SURGEON=$G(PRCPSDAT(130,SURGDA,.14,"I")) I SURGEON S DR=DR_"130.04///`"_SURGEON_";"
|
|---|
| 33 | ; principal procedure code
|
|---|
| 34 | S OPCODE=$G(PRCPSDAT(130,SURGDA,27,"I")) I OPCODE S DR=DR_"130.01///`"_OPCODE_";"
|
|---|
| 35 | ;
|
|---|
| 36 | ; add fields to entry
|
|---|
| 37 | L +^PRCP(446.1,DA)
|
|---|
| 38 | S (DIC,DIE)="^PRCP(446.1," D ^DIE
|
|---|
| 39 | L -^PRCP(446.1,DA)
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | ;
|
|---|
| 43 | ADD(DATETIME,PATDFN) ; add new entry to patient distribution file
|
|---|
| 44 | N %,DA,D0,DD,DI,DIC,DIE,DINUM,DLAYGO,DQ,DR,PRCPPRIV,X,Y
|
|---|
| 45 | L +^PRCP(446.1)
|
|---|
| 46 | S DIC="^PRCP(446.1,",DIC(0)="L",DIC("DR")="2///`"_PATDFN,DLAYGO=446.1,PRCPPRIV=1,(DINUM,X)=DATETIME
|
|---|
| 47 | D FILE^DICN
|
|---|
| 48 | L -^PRCP(446.1)
|
|---|
| 49 | Q +Y
|
|---|
| 50 | ;
|
|---|
| 51 | ;
|
|---|
| 52 | DISTITEM(DATETIME,ITEMDA,QTY,COST) ; distribute itemda to patient
|
|---|
| 53 | ; qty and cost distributed
|
|---|
| 54 | I '$D(^PRCP(446.1,DATETIME,0)) Q
|
|---|
| 55 | L +^PRCP(446.1,DATETIME)
|
|---|
| 56 | N DATA
|
|---|
| 57 | I '$D(^PRCP(446.1,DATETIME,445,ITEMDA,0)) D
|
|---|
| 58 | . I '$D(^PRCP(446.1,DATETIME,445,0)) S ^(0)="^446.11P^^"
|
|---|
| 59 | . N D0,DA,DD,DIC,DLAYGO,X,Y
|
|---|
| 60 | . S DIC="^PRCP(446.1,"_DATETIME_",445,",DIC(0)="L",DLAYGO=446.1,DA(1)=DATETIME,(X,DINUM)=ITEMDA D FILE^DICN
|
|---|
| 61 | S DATA=$G(^PRCP(446.1,DATETIME,445,ITEMDA,0)) I DATA="" L -^PRCP(446.1,DATETIME) Q
|
|---|
| 62 | S $P(DATA,"^",2)=$P(DATA,"^",2)+QTY
|
|---|
| 63 | S $P(DATA,"^",3)=$P(DATA,"^",3)+COST
|
|---|
| 64 | S ^PRCP(446.1,DATETIME,445,ITEMDA,0)=DATA
|
|---|
| 65 | S $P(^PRCP(446.1,DATETIME,0),"^",5)=$P(^PRCP(446.1,DATETIME,0),"^",5)+COST
|
|---|
| 66 | L -^PRCP(446.1,DATETIME)
|
|---|
| 67 | Q
|
|---|
| 68 | ;
|
|---|
| 69 | ;
|
|---|
| 70 | SELECT() ; return selected entry
|
|---|
| 71 | N %,DIC,PRCPPRIV,X,Y
|
|---|
| 72 | S DIC="^PRCP(446.1,",DIC(0)="QEAM",PRCPPRIV=1
|
|---|
| 73 | D ^DIC
|
|---|
| 74 | Q $S(Y'>0:0,1:+Y)
|
|---|
