PSOQCF04 ;HINES/RMS - NON-VA MEDS DOCUMENTATION DATE ; 30 Nov 2007 7:55 AM
;;7.0;OUTPATIENT PHARMACY;**294**;DEC 1997;Build 13
;
NVADT(DFN,TEST,DATE,VALUE,TEXT) ;
N PSOQL,PSOQDT,PSOQARR,PSOQRDT
S TEST=0,DATE=""
D ^PSOHCSUM
Q:'$D(^TMP("PSOO",$J,"NVA"))
S PSOQL=0 F S PSOQL=$O(^TMP("PSOO",$J,"NVA",PSOQL)) Q:'+PSOQL D ;
. S PSOQDT=9999999-$P($G(^TMP("PSOO",$J,"NVA",PSOQL,0)),"^",5)
. S PSOQARR(PSOQDT)=""
S PSOQRDT=$O(PSOQARR(0)) Q:PSOQRDT=9999999
S TEST=1,DATE=9999999-PSOQRDT,TEXT=$$FMTE^XLFDT(DATE,"D")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOQCF04 537 printed Oct 16, 2024@18:33:57 Page 2
PSOQCF04 ;HINES/RMS - NON-VA MEDS DOCUMENTATION DATE ; 30 Nov 2007 7:55 AM
+1 ;;7.0;OUTPATIENT PHARMACY;**294**;DEC 1997;Build 13
+2 ;
NVADT(DFN,TEST,DATE,VALUE,TEXT) ;
+1 NEW PSOQL,PSOQDT,PSOQARR,PSOQRDT
+2 SET TEST=0
SET DATE=""
+3 DO ^PSOHCSUM
+4 if '$DATA(^TMP("PSOO",$JOB,"NVA"))
QUIT
+5 ;
SET PSOQL=0
FOR
SET PSOQL=$ORDER(^TMP("PSOO",$JOB,"NVA",PSOQL))
if '+PSOQL
QUIT
Begin DoDot:1
+6 SET PSOQDT=9999999-$PIECE($GET(^TMP("PSOO",$JOB,"NVA",PSOQL,0)),"^",5)
+7 SET PSOQARR(PSOQDT)=""
End DoDot:1
+8 SET PSOQRDT=$ORDER(PSOQARR(0))
if PSOQRDT=9999999
QUIT
+9 SET TEST=1
SET DATE=9999999-PSOQRDT
SET TEXT=$$FMTE^XLFDT(DATE,"D")
+10 QUIT