source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPCSOU.m@ 1769

Last change on this file since 1769 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 1.6 KB
RevLine 
[613]1PRCPCSOU ;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 ;
7SHOWORD(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 ;
21SHOWCC(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
Note: See TracBrowser for help on using the repository browser.