| 1 | PRCPCSOU ;WISC/RFJ-surgery order supplies utilities ;01 Sep 93
|
|---|
| 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 | SHOWORD(PATIENT,SURGERY) ; show orders placed for patient da and surgery da
|
|---|
| 8 | N %,DA,DATA,DATE,PRCPFLAG,PRCPFREL,SCREEN,Y
|
|---|
| 9 | W !!,"ORDERS WHICH HAVE BEEN PLACED FOR OPERATION:"
|
|---|
| 10 | I '$D(^PRCP(445.3,"ASR",PATIENT,SURGERY)) W !?2,"<< NONE >>" Q
|
|---|
| 11 | S (DA,SCREEN)=0 F S DA=$O(^PRCP(445.3,"ASR",PATIENT,SURGERY,DA)) Q:'DA!($G(PRCPFLAG)) D
|
|---|
| 12 | . I SCREEN>(IOSL-5) D P^PRCPUREP Q:$G(PRCPFLAG) S SCREEN=0
|
|---|
| 13 | . S DATA=$G(^PRCP(445.3,DA,0)) I DATA="" Q
|
|---|
| 14 | . S Y=$P(DATA,"^",4) D DD^%DT S DATE=Y,SCREEN=SCREEN+1
|
|---|
| 15 | . W !,"Order # ",$P(DATA,"^"),?15,"Date: ",DATE,?35,"By: ",$E($$USER^PRCPUREP($P(DATA,"^",5)),1,18),?54,"Status: ",$$STATUS^PRCPOPU(DA)
|
|---|
| 16 | . I $P(DATA,"^",6)'="" S PRCPFREL=1
|
|---|
| 17 | I $G(PRCPFREL) W !,"** TO DELETE ORDERS WHICH HAVE BEEN RELEASED FOR PROCESSING, PLEASE PHONE SPD **"
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | ;
|
|---|
| 21 | SHOWCC(OPERATE,ORDERDA) ; show case carts linked to operation da, order da
|
|---|
| 22 | N %,DA,DATA,PRCPFLAG,SCREEN
|
|---|
| 23 | W !!,"Case Carts to Order for Operation: ",OPERATE," ",$P($$ICPT^PRCPCUT1(+OPERATE),"^",2)
|
|---|
| 24 | I '$D(^PRCP(445.7,"AOP",OPERATE)) W !?5,"<< NONE SPECIFIED >>" Q
|
|---|
| 25 | S (DA,SCREEN)=0 F S DA=$O(^PRCP(445.7,"AOP",OPERATE,DA)) Q:'DA!($G(PRCPFLAG)) D
|
|---|
| 26 | . I SCREEN>(IOSL-5) D P^PRCPUREP Q:$G(PRCPFLAG) S SCREEN=0
|
|---|
| 27 | . S DATA=$G(^PRCP(445.7,DA,0)) I DATA="" Q
|
|---|
| 28 | . S SCREEN=SCREEN+1
|
|---|
| 29 | . W !?5,$E($$DESCR^PRCPUX1($P(DATA,"^",2),DA),1,30),?32,"#",DA,?42
|
|---|
| 30 | . S %=$G(^PRCP(445.3,ORDERDA,1,DA,0))
|
|---|
| 31 | . I %="" W "*** NOT ORDERED ***" Q
|
|---|
| 32 | . W "QTY ORDERED: ",$P(%,"^",2)
|
|---|
| 33 | Q
|
|---|
