PSOQCF04.m

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

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