PRSN9B ;;WOIFO/PLT - RPC POC Daily Time Extraction ; 08/14/2009 7:56 AM
;;4.0;PAID;**126**;Sep 21, 1995;Build 59
;;Per VHA Directive 2004-038, this routine should not be modified.
QUIT
;
;.ret - rpc return value with return value type: global array
;prsnseq - rpc parameter 1 with type: literal after sequence number requested in format nnnn...
;prsnrec - rpc parameter 2 with type: literal number of records requested in format nnn...
POCTIME(RET,PRSNSEQ,PRSNREC) ;remote procedure call - extract poc daily time records
N PRSNA,PRSNB,PRSNC,PRSNSITE,PRSNGLB,PRSNEND
;get the current last record in file #451.7
S PRSNEND=$O(^PRSN(451.7,":"),-1)
K ^TMP("PRSN",$J,"RPCPOC") S PRSNGLB=$NAME(^TMP("PRSN",$J,"RPCPOC"))
;start record after prsnseq
S PRSNA=PRSNSEQ,PRSNB=0 F S PRSNA=$O(^PRSN(451.7,PRSNA)),PRSNB=PRSNB+1 QUIT:PRSNA>PRSNEND!(PRSNB>PRSNREC)!'PRSNA S @PRSNGLB@(PRSNA)=^(PRSNA,0)
;set the header node
S PRSNSITE=$P($G(^XMB(1,1,"XUS")),"^",17),PRSNSITE=$S(+PRSNSITE>0:$P($G(^DIC(4,PRSNSITE,99)),"^",1),1:"")
S PRSNA=$O(@PRSNGLB@(0)),PRSNC=$O(@PRSNGLB@(":"),-1),PRSNB=PRSNB-1
S @PRSNGLB@(0)=PRSNSITE_"^"_PRSNA_"^"_PRSNC_"^"_PRSNB_"^"_PRSNEND
S RET=$NAME(^TMP("PRSN",$J,"RPCPOC"))
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSN9B 1234 printed Dec 13, 2024@02:27:02 Page 2
PRSN9B ;;WOIFO/PLT - RPC POC Daily Time Extraction ; 08/14/2009 7:56 AM
+1 ;;4.0;PAID;**126**;Sep 21, 1995;Build 59
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;.ret - rpc return value with return value type: global array
+6 ;prsnseq - rpc parameter 1 with type: literal after sequence number requested in format nnnn...
+7 ;prsnrec - rpc parameter 2 with type: literal number of records requested in format nnn...
POCTIME(RET,PRSNSEQ,PRSNREC) ;remote procedure call - extract poc daily time records
+1 NEW PRSNA,PRSNB,PRSNC,PRSNSITE,PRSNGLB,PRSNEND
+2 ;get the current last record in file #451.7
+3 SET PRSNEND=$ORDER(^PRSN(451.7,":"),-1)
+4 KILL ^TMP("PRSN",$JOB,"RPCPOC")
SET PRSNGLB=$NAME(^TMP("PRSN",$JOB,"RPCPOC"))
+5 ;start record after prsnseq
+6 SET PRSNA=PRSNSEQ
SET PRSNB=0
FOR
SET PRSNA=$ORDER(^PRSN(451.7,PRSNA))
SET PRSNB=PRSNB+1
if PRSNA>PRSNEND!(PRSNB>PRSNREC)!'PRSNA
QUIT
SET @PRSNGLB@(PRSNA)=^(PRSNA,0)
+7 ;set the header node
+8 SET PRSNSITE=$PIECE($GET(^XMB(1,1,"XUS")),"^",17)
SET PRSNSITE=$SELECT(+PRSNSITE>0:$PIECE($GET(^DIC(4,PRSNSITE,99)),"^",1),1:"")
+9 SET PRSNA=$ORDER(@PRSNGLB@(0))
SET PRSNC=$ORDER(@PRSNGLB@(":"),-1)
SET PRSNB=PRSNB-1
+10 SET @PRSNGLB@(0)=PRSNSITE_"^"_PRSNA_"^"_PRSNC_"^"_PRSNB_"^"_PRSNEND
+11 SET RET=$NAME(^TMP("PRSN",$JOB,"RPCPOC"))
+12 QUIT
+13 ;
