PRCPCSO1 ;WISC/RFJ-surgery order supplies ; 06/23/2009 2:26 PM
;;5.1;IFCAP;**136**;Oct 20, 2000;Build 6
;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
;
AUTOORD ; automatically create order
N ORDERNO
D SHOWCC^PRCPCSOU(OPCODE,0,$G(OPDATEI))
S XP="Do you want to automatically create and add items to a new order"
S XH="Enter 'YES' to automatically create an order with the items on it,",XH(1)="enter 'NO' to select the order and items, or",XH(2)="enter '^' to select a new patient and operation."
W ! S %=$$YN^PRCPUYN(1)
I %=2 Q
I %'=1 S PRCPFLAG=1 Q
W !!,"CREATING ORDER:"
D NEWORDER^PRCPOPUS(PRCPPRIM) I '$G(X) S ORDERDA=0 Q
S ORDERNO=X
S ORDERDA=+$$ADDNEW^PRCPOPUS(ORDERNO,PRCPPRIM,PRCPSECO) I 'ORDERDA Q
L +^PRCP(445.3,ORDERDA):5 I '$T D SHOWWHO^PRCPULOC(445.3,ORDERDA,0) S ORDERDA=0 Q
D ADD^PRCPULOC(445.3,ORDERDA,0,"Ordering Surgical Supplies")
; tie patient and operation to the order
D PATLINK^PRCPCSOR(ORDERDA,PRCPPAT,PRCPSURG)
W " NUMBER ",ORDERNO
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPCSO1 1034 printed Oct 16, 2024@18:14 Page 2
PRCPCSO1 ;WISC/RFJ-surgery order supplies ; 06/23/2009 2:26 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 ;
AUTOORD ; automatically create order
+1 NEW ORDERNO
+2 DO SHOWCC^PRCPCSOU(OPCODE,0,$GET(OPDATEI))
+3 SET XP="Do you want to automatically create and add items to a new order"
+4 SET XH="Enter 'YES' to automatically create an order with the items on it,"
SET XH(1)="enter 'NO' to select the order and items, or"
SET XH(2)="enter '^' to select a new patient and operation."
+5 WRITE !
SET %=$$YN^PRCPUYN(1)
+6 IF %=2
QUIT
+7 IF %'=1
SET PRCPFLAG=1
QUIT
+8 WRITE !!,"CREATING ORDER:"
+9 DO NEWORDER^PRCPOPUS(PRCPPRIM)
IF '$GET(X)
SET ORDERDA=0
QUIT
+10 SET ORDERNO=X
+11 SET ORDERDA=+$$ADDNEW^PRCPOPUS(ORDERNO,PRCPPRIM,PRCPSECO)
IF 'ORDERDA
QUIT
+12 LOCK +^PRCP(445.3,ORDERDA):5
IF '$TEST
DO SHOWWHO^PRCPULOC(445.3,ORDERDA,0)
SET ORDERDA=0
QUIT
+13 DO ADD^PRCPULOC(445.3,ORDERDA,0,"Ordering Surgical Supplies")
+14 ; tie patient and operation to the order
+15 DO PATLINK^PRCPCSOR(ORDERDA,PRCPPAT,PRCPSURG)
+16 WRITE " NUMBER ",ORDERNO
+17 QUIT
