PRCPCSOU ;WISC/RFJ-surgery order supplies utilities ; 06/23/2009 2:17 PM
;;5.1;IFCAP;**136**;Oct 20, 2000;Build 6
;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
;
SHOWORD(PATIENT,SURGERY) ; show orders placed for patient da and surgery da
N %,DA,DATA,DATE,PRCPFLAG,PRCPFREL,SCREEN,Y
W !!,"ORDERS WHICH HAVE BEEN PLACED FOR OPERATION:"
I '$D(^PRCP(445.3,"ASR",PATIENT,SURGERY)) W !?2,"<< NONE >>" Q
S (DA,SCREEN)=0 F S DA=$O(^PRCP(445.3,"ASR",PATIENT,SURGERY,DA)) Q:'DA!($G(PRCPFLAG)) D
. I SCREEN>(IOSL-5) D P^PRCPUREP Q:$G(PRCPFLAG) S SCREEN=0
. S DATA=$G(^PRCP(445.3,DA,0)) I DATA="" Q
. S Y=$P(DATA,"^",4) D DD^%DT S DATE=Y,SCREEN=SCREEN+1
. W !,"Order # ",$P(DATA,"^"),?15,"Date: ",DATE,?35,"By: ",$E($$USER^PRCPUREP($P(DATA,"^",5)),1,18),?54,"Status: ",$$STATUS^PRCPOPU(DA)
. I $P(DATA,"^",6)'="" S PRCPFREL=1
I $G(PRCPFREL) W !,"** TO DELETE ORDERS WHICH HAVE BEEN RELEASED FOR PROCESSING, PLEASE PHONE SPD **"
Q
;
;operate = ien of file #81
;orderda = ien of file #445.3
;prcdt = fileman date
SHOWCC(OPERATE,ORDERDA,PRCDT) ;show case carts linked to operation da, order da
N %,DA,DATA,PRCPFLAG,SCREEN
W !!,"Case Carts to Order for Operation: ",$TR($$ICPT^PRCPCUT1(+OPERATE,$G(PRCDT)),"^"," ")
I '$D(^PRCP(445.7,"AOP",OPERATE)) W !?5,"<< NONE SPECIFIED >>" Q
S (DA,SCREEN)=0 F S DA=$O(^PRCP(445.7,"AOP",OPERATE,DA)) Q:'DA!($G(PRCPFLAG)) D
. I SCREEN>(IOSL-5) D P^PRCPUREP Q:$G(PRCPFLAG) S SCREEN=0
. S DATA=$G(^PRCP(445.7,DA,0)) I DATA="" Q
. S SCREEN=SCREEN+1
. W !?5,$E($$DESCR^PRCPUX1($P(DATA,"^",2),DA),1,30),?32,"#",DA,?42
. S %=$G(^PRCP(445.3,ORDERDA,1,DA,0))
. I %="" W "*** NOT ORDERED ***" Q
. W "QTY ORDERED: ",$P(%,"^",2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPCSOU 1763 printed Dec 13, 2024@02:13:18 Page 2
PRCPCSOU ;WISC/RFJ-surgery order supplies utilities ; 06/23/2009 2:17 PM
+1 ;;5.1;IFCAP;**136**;Oct 20, 2000;Build 6
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
SHOWORD(PATIENT,SURGERY) ; show orders placed for patient da and surgery da
+1 NEW %,DA,DATA,DATE,PRCPFLAG,PRCPFREL,SCREEN,Y
+2 WRITE !!,"ORDERS WHICH HAVE BEEN PLACED FOR OPERATION:"
+3 IF '$DATA(^PRCP(445.3,"ASR",PATIENT,SURGERY))
WRITE !?2,"<< NONE >>"
QUIT
+4 SET (DA,SCREEN)=0
FOR
SET DA=$ORDER(^PRCP(445.3,"ASR",PATIENT,SURGERY,DA))
if 'DA!($GET(PRCPFLAG))
QUIT
Begin DoDot:1
+5 IF SCREEN>(IOSL-5)
DO P^PRCPUREP
if $GET(PRCPFLAG)
QUIT
SET SCREEN=0
+6 SET DATA=$GET(^PRCP(445.3,DA,0))
IF DATA=""
QUIT
+7 SET Y=$PIECE(DATA,"^",4)
DO DD^%DT
SET DATE=Y
SET SCREEN=SCREEN+1
+8 WRITE !,"Order # ",$PIECE(DATA,"^"),?15,"Date: ",DATE,?35,"By: ",$EXTRACT($$USER^PRCPUREP($PIECE(DATA,"^",5)),1,18),?54,"Status: ",$$STATUS^PRCPOPU(DA)
+9 IF $PIECE(DATA,"^",6)'=""
SET PRCPFREL=1
End DoDot:1
+10 IF $GET(PRCPFREL)
WRITE !,"** TO DELETE ORDERS WHICH HAVE BEEN RELEASED FOR PROCESSING, PLEASE PHONE SPD **"
+11 QUIT
+12 ;
+13 ;operate = ien of file #81
+14 ;orderda = ien of file #445.3
+15 ;prcdt = fileman date
SHOWCC(OPERATE,ORDERDA,PRCDT) ;show case carts linked to operation da, order da
+1 NEW %,DA,DATA,PRCPFLAG,SCREEN
+2 WRITE !!,"Case Carts to Order for Operation: ",$TRANSLATE($$ICPT^PRCPCUT1(+OPERATE,$GET(PRCDT)),"^"," ")
+3 IF '$DATA(^PRCP(445.7,"AOP",OPERATE))
WRITE !?5,"<< NONE SPECIFIED >>"
QUIT
+4 SET (DA,SCREEN)=0
FOR
SET DA=$ORDER(^PRCP(445.7,"AOP",OPERATE,DA))
if 'DA!($GET(PRCPFLAG))
QUIT
Begin DoDot:1
+5 IF SCREEN>(IOSL-5)
DO P^PRCPUREP
if $GET(PRCPFLAG)
QUIT
SET SCREEN=0
+6 SET DATA=$GET(^PRCP(445.7,DA,0))
IF DATA=""
QUIT
+7 SET SCREEN=SCREEN+1
+8 WRITE !?5,$EXTRACT($$DESCR^PRCPUX1($PIECE(DATA,"^",2),DA),1,30),?32,"#",DA,?42
+9 SET %=$GET(^PRCP(445.3,ORDERDA,1,DA,0))
+10 IF %=""
WRITE "*** NOT ORDERED ***"
QUIT
+11 WRITE "QTY ORDERED: ",$PIECE(%,"^",2)
End DoDot:1
+12 QUIT
