PPPSCN2 ;ALB/DMB - PPP CLINIC SCAN ROUTINE ; 2/20/92 ;;1.0;PHARMACY PRESCRIPTION PRACTICE;**9,41,42**;APR 7,1995;Build 4 ;;Per VHA Directive 10-93-142, this routine should not be modified. ;Reference to GETPLIST^SDAMA202 supported by IA #3869 ;Reference to ^SC("AC" supported by IA #4084 ; FFSCAN ; Scan clinic for patients to send PDX's for ; N X,TMP,DTCERR,PFGERR,CSCNSTRT,CSCNEND,DATE,SCANDATE,PCSD,TOTPATS N PDXSTRT,PDXEND,CODE,ERR,FFXIFN,LPDX,MAXDAYS,RSLTPTR,UNSPTR N PATDFN,STAPTR,TOTSTA,X1,X2,PROCPTR,AUTOPTR ; S PPPMRT="FFSCAN_PPPSCN2" S DTCERR=-9006 S PFGERR=-9007 S CSCNSTRT=1006 S CSCNEND=1007 S PDXSTRT=1008 S PDXEND=1009 S ^TMP("PPP",$J,"ERR",1)="The following Errors occurred while attempting to send PDX's:" S ^TMP("PPP",$J,"ERR",2)=" " S (PDXSNT,TOTSTA)=0 S ERR=0 ;GET POINTERS TO ACCEPTABLE PDX STATUSES S RSLTPTR=$$GETSTPTR^PPPGET7("VAQ-RSLT") S UNSPTR=$$GETSTPTR^PPPGET7("VAQ-UNSOL") S PROCPTR=$$GETSTPTR^PPPGET7("VAQ-PROC") S AUTOPTR=$$GETSTPTR^PPPGET7("VAQ-AUTO") ; S TMP=$$LOGEVNT^PPPMSC1(CSCNSTRT,PPPMRT) ; D NOW^%DTC I X="" D Q .S TMP=$$LOGEVNT^PPPMSC1(DTCERR,PPPMRT) S DATE=X K %,%H,%I,X ; S PCSD=$P($G(^PPP(1020.1,1,0)),"^",2) I PCSD="" D Q .S TMP=$$LOGEVNT^PPPMSC1(PFGERR,PPPMRT) S X1=DATE S X2=PCSD D C^%DTC I X="" D Q .S TMP=$$LOGEVNT^PPPMSC1(DTCERR,PPPMRT) S SCANDATE=X K X1,X2,X,%H ; S TOTPATS=$$CLINSCAN(SCANDATE,"^TMP(""PPP"",$J,SCANDATE)") S TMP=$$LOGEVNT^PPPMSC1(CSCNEND,PPPMRT,"TOTAL ENTRIES = "_TOTPATS) ; S MAXDAYS=$P($G(^PPP(1020.1,1,0)),"^",3) S TMP=$$LOGEVNT^PPPMSC1(PDXSTRT,PPPMRT) ; F PATDFN=0:0 D Q:PATDFN="" .K PPPSTA .S PATDFN=$O(^TMP("PPP",$J,SCANDATE,PATDFN)) Q:PATDFN="" .F STAPTR=0:0 D Q:STAPTR="" ..S STAPTR=$O(^PPP(1020.2,"APOV",PATDFN,STAPTR)) Q:STAPTR="" ..S FFXIFN=$O(^PPP(1020.2,"APOV",PATDFN,STAPTR,"")) Q:FFXIFN="" ..I '$D(^PPP(1020.5,"B",STAPTR)) D ...S LPDX=$P($G(^PPP(1020.2,FFXIFN,1)),"^",2) ...I LPDX=""!($$DIFFDT^PPPCNV1(DATE,LPDX)>MAXDAYS) D ....S CODE=$P($G(^PPP(1020.2,FFXIFN,1)),"^",3) ....I ((CODE=RSLTPTR)!(CODE=UNSPTR)!(CODE=PROCPTR)!(CODE=AUTOPTR)!(CODE="")) D .....S PPPSTA(STAPTR)="" .....S TOTSTA=TOTSTA+1 .I $O(PPPSTA(""))'="" D Q:ERR ..S ERR=$$SNDPDX^PPPPDX1(PATDFN,"PPPSTA","^TMP(""PPP"",$J,""ERR"")") ..I ERR D ...S TMP=$$LOGEVNT^PPPMSC1(ERR,PPPMRT,"Error From PPPPDX1 ==> "_ERR) ...S PATDFN="" ; ; Set the last batch request date to today ; S $P(^PPP(1020.1,1,0),"^",6)=DT S TMP=$$LOGEVNT^PPPMSC1(PDXEND,PPPMRT,"TOTAL PDX'S REQUESTED = "_TOTSTA) I '$D(^TMP("PPP",$J,"ERR",3)) S ^TMP("PPP",$J,"ERR",1)="No Errors occurred while attempting to send PDX's" ;S ^TMP("PPP",$J,"ERR",4)="" S TMP=$$SNDBLTN^PPPMSC1("PPP DAILY BATCH "_$$SLASHDT^PPPCNV1(DT),"PRESCRIPTION PRACTICES","^TMP(""PPP"",$J,""ERR"",") ; K ^TMP("PPP",$J,"ERR"),^TMP("PPP",$J,SCANDATE),PPPMRT,PPPSTA,PDXSNT Q ; CLINSCAN(SCANDATE,ARRYNM) ; Scan the clinics for appointments N CLINIC,PATDFN,TPATS,SEQ ; S CLINIC="",TPATS=0 F S CLINIC=$O(^SC("AC","C",CLINIC)) Q:CLINIC="" D .K ^TMP($J,"SDAMA202","GETPLIST") .D GETPLIST^SDAMA202(CLINIC,"3;4;12",,SCANDATE,SCANDATE) .S SEQ=0 .F S SEQ=$O(^TMP($J,"SDAMA202","GETPLIST",SEQ)) Q:'SEQ D ..I $P($G(^TMP($J,"SDAMA202","GETPLIST",SEQ,3)),"^")="R",$P($G(^TMP($J,"SDAMA202","GETPLIST",SEQ,12)),"^")="O" D ...S PATDFN=+$G(^TMP($J,"SDAMA202","GETPLIST",SEQ,4)) Q:'PATDFN ...S @ARRYNM@(PATDFN)="" ...S TPATS=TPATS+1 K ^TMP($J,"SDAMA202","GETPLIST") ; Q TPATS