Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCPCSOU

PRCPCSOU.m

Go to the documentation of this file.
  1. PRCPCSOU ;WISC/RFJ-surgery order supplies utilities ; 06/23/2009 2:17 PM
  1. ;;5.1;IFCAP;**136**;Oct 20, 2000;Build 6
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. SHOWORD(PATIENT,SURGERY) ; show orders placed for patient da and surgery da
  1. N %,DA,DATA,DATE,PRCPFLAG,PRCPFREL,SCREEN,Y
  1. W !!,"ORDERS WHICH HAVE BEEN PLACED FOR OPERATION:"
  1. I '$D(^PRCP(445.3,"ASR",PATIENT,SURGERY)) W !?2,"<< NONE >>" Q
  1. S (DA,SCREEN)=0 F S DA=$O(^PRCP(445.3,"ASR",PATIENT,SURGERY,DA)) Q:'DA!($G(PRCPFLAG)) D
  1. . I SCREEN>(IOSL-5) D P^PRCPUREP Q:$G(PRCPFLAG) S SCREEN=0
  1. . S DATA=$G(^PRCP(445.3,DA,0)) I DATA="" Q
  1. . S Y=$P(DATA,"^",4) D DD^%DT S DATE=Y,SCREEN=SCREEN+1
  1. . W !,"Order # ",$P(DATA,"^"),?15,"Date: ",DATE,?35,"By: ",$E($$USER^PRCPUREP($P(DATA,"^",5)),1,18),?54,"Status: ",$$STATUS^PRCPOPU(DA)
  1. . I $P(DATA,"^",6)'="" S PRCPFREL=1
  1. I $G(PRCPFREL) W !,"** TO DELETE ORDERS WHICH HAVE BEEN RELEASED FOR PROCESSING, PLEASE PHONE SPD **"
  1. Q
  1. ;
  1. ;operate = ien of file #81
  1. ;orderda = ien of file #445.3
  1. ;prcdt = fileman date
  1. SHOWCC(OPERATE,ORDERDA,PRCDT) ;show case carts linked to operation da, order da
  1. N %,DA,DATA,PRCPFLAG,SCREEN
  1. W !!,"Case Carts to Order for Operation: ",$TR($$ICPT^PRCPCUT1(+OPERATE,$G(PRCDT)),"^"," ")
  1. I '$D(^PRCP(445.7,"AOP",OPERATE)) W !?5,"<< NONE SPECIFIED >>" Q
  1. S (DA,SCREEN)=0 F S DA=$O(^PRCP(445.7,"AOP",OPERATE,DA)) Q:'DA!($G(PRCPFLAG)) D
  1. . I SCREEN>(IOSL-5) D P^PRCPUREP Q:$G(PRCPFLAG) S SCREEN=0
  1. . S DATA=$G(^PRCP(445.7,DA,0)) I DATA="" Q
  1. . S SCREEN=SCREEN+1
  1. . W !?5,$E($$DESCR^PRCPUX1($P(DATA,"^",2),DA),1,30),?32,"#",DA,?42
  1. . S %=$G(^PRCP(445.3,ORDERDA,1,DA,0))
  1. . I %="" W "*** NOT ORDERED ***" Q
  1. . W "QTY ORDERED: ",$P(%,"^",2)
  1. Q