- 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 Feb 18, 2025@23:39:40 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