Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOEOPNW

PSOEOPNW.m

Go to the documentation of this file.
PSOEOPNW ;EPIP/RTW - End of Prescription Numbering Warning ; 7/11/17 8:53AM
 ;;7.0;OUTPATIENT PHARMACY;**452**;DEC 1997;Build 56
 ;---------------------------------------------------------------------
 ; ICR#   TYPE    DESCRIPTION
 ;-----  -------  ------------------------------------------
 ;10063  Support  %ZTLOAD
 ;10086  Support  %ZIS
 ;10089  Support  %ZISC
 ;10003  Support  ^%DT
 ;10103  Support  ^XLFDT: $$FMTE, $$NOW
 ;---------------------------------------------------------------------
 S %ZIS="Q" D ^%ZIS G:POP EXIT
 I $D(IO("Q")) S ZTRTN="CHECK2^PSOEOPNW" D ^%ZTLOAD,HOME^%ZIS G EXIT
CHECK2 ;
 U IO
CHECK ;
 N PSORXLMT,PSOSORT
 I $D(^PS(59.7,1,48)),$G(^PS(59.7,1,48)) S PSORXLMT=$P(^PS(59.7,1,48),U),^TMP("PSOEOPNW",0)="9999999^"_$$FMTE^XLFDT($$NOW^XLFDT,"1M")_"^End of Prescription Numbering Warning^"_PSORXLMT
 I '$D(^TMP("PSOEOPNW")) S ^TMP("PSOEOPNW",0)="9999999^"_$$FMTE^XLFDT($$NOW^XLFDT,"1M")_"^End of Prescription Numbering Warning^1000"
 K ^TMP($J)
 S PSOLINE=1
 S PSOLIMIT=$P(^TMP("PSOEOPNW",0),U,4)
 S ^TMP($J,PSOLINE)="LIMIT: "_PSOLIMIT,PSOLINE=PSOLINE+1
 F PSOIEN=0:0 S PSOIEN=$O(^PS(59,PSOIEN)) Q:'PSOIEN  DO
 . Q:$E($P(^PS(59,PSOIEN,0),U),1,2)="ZZ"
 . I $G(^PS(59,PSOIEN,"I")) Q:$P(^PS(59,PSOIEN,"I"),U)'>DT
 . S PSOLOW=$P($G(^PS(59,PSOIEN,3)),U,1),PSOMAX=$P($G(^PS(59,PSOIEN,3)),U,2),PSOLAST=$P($G(^PS(59,PSOIEN,3)),U,3)
 . S PSODIFF=PSOMAX-PSOLAST
 . S PSOSORT=$P($G(^PS(59,PSOIEN,2)),U,1)  ;RTW added to check to see if a site sorts Narcotics separately.
 . I PSODIFF<PSOLIMIT,($G(PSOSORT)) DO WARN("NARCOTIC") ;RTW
 . S PSOLOW=$P($G(^PS(59,PSOIEN,8)),U,1),PSOMAX=$P($G(^PS(59,PSOIEN,8)),U,2),PSOLAST=$P($G(^PS(59,PSOIEN,8)),U,3)
 . S PSODIFF=PSOMAX-PSOLAST
 . I PSODIFF<PSOLIMIT DO WARN("PRESCRIPTION #")
 ;
 D:PSOLINE>2
 . S $P(^TMP("PSOEOPNW",0),U,2)=$$FMTE^XLFDT($$NOW^XLFDT,"1M")
 . S $P(^TMP("PSOEOPNW",0),U,4)=PSOLIMIT
 . S XMSUB="End of Prescribing Numbering WARNING"
 . S (XMDUZ,DUZ)=.5
 . S XMTEXT="^TMP($J)"
 . S XMY("G.PHARMACY SUPERVISORS")=""
 . S XMINSTR("FLAGS")="P"
 . DO SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.XMINSTR)
 G EXIT
WARN(PSOFOO) ;
 S ^TMP($J,PSOLINE)="",PSOLINE=PSOLINE+1
 S ^TMP($J,PSOLINE)="SITE: "_$P(^PS(59,PSOIEN,0),U),PSOLINE=PSOLINE+1
 S ^TMP($J,PSOLINE)=PSOFOO_" LOWER BOUND       : "_PSOLOW,PSOLINE=PSOLINE+1
 S ^TMP($J,PSOLINE)=PSOFOO_" UPPER BOUND       : "_PSOMAX,PSOLINE=PSOLINE+1
 S ^TMP($J,PSOLINE)="LAST "_PSOFOO_" ISSUED       : "_PSOLAST,PSOLINE=PSOLINE+1
 S ^TMP($J,PSOLINE)="There are "_PSODIFF_" Numbers left, a new series needs to be defined.",PSOLINE=PSOLINE+1
 I PSODIFF<250 S ^TMP($J,PSOLINE)="*** EXTREMELY LOW ***",PSOLINE=PSOLINE+1
 QUIT
EXIT ;
 K %ZIS,PSODIFF,PSOFOO,PSOIEN,PSOLAST,PSOLIMIT,PSOLINE,PSOLOW,PSOMAX,POP,XMDUZ,XMINSTR,XMSUB
 K XMTEXT,XMY,ZTRTN,^TMP($J),^TMP("PSOEOPNW")
 D:$D(ZTQUEUED) KILL^%ZTLOAD
 D ^%ZISC QUIT