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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOEOPNW 2878 printed Nov 22, 2024@17:37:30 Page 2
PSOEOPNW ;EPIP/RTW - End of Prescription Numbering Warning ; 7/11/17 8:53AM
+1 ;;7.0;OUTPATIENT PHARMACY;**452**;DEC 1997;Build 56
+2 ;---------------------------------------------------------------------
+3 ; ICR# TYPE DESCRIPTION
+4 ;----- ------- ------------------------------------------
+5 ;10063 Support %ZTLOAD
+6 ;10086 Support %ZIS
+7 ;10089 Support %ZISC
+8 ;10003 Support ^%DT
+9 ;10103 Support ^XLFDT: $$FMTE, $$NOW
+10 ;---------------------------------------------------------------------
+11 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
+12 IF $DATA(IO("Q"))
SET ZTRTN="CHECK2^PSOEOPNW"
DO ^%ZTLOAD
DO HOME^%ZIS
GOTO EXIT
CHECK2 ;
+1 USE IO
CHECK ;
+1 NEW PSORXLMT,PSOSORT
+2 IF $DATA(^PS(59.7,1,48))
IF $GET(^PS(59.7,1,48))
SET PSORXLMT=$PIECE(^PS(59.7,1,48),U)
SET ^TMP("PSOEOPNW",0)="9999999^"_$$FMTE^XLFDT($$NOW^XLFDT,"1M")_"^End of Prescription Numbering Warning^"_PSORXLMT
+3 IF '$DATA(^TMP("PSOEOPNW"))
SET ^TMP("PSOEOPNW",0)="9999999^"_$$FMTE^XLFDT($$NOW^XLFDT,"1M")_"^End of Prescription Numbering Warning^1000"
+4 KILL ^TMP($JOB)
+5 SET PSOLINE=1
+6 SET PSOLIMIT=$PIECE(^TMP("PSOEOPNW",0),U,4)
+7 SET ^TMP($JOB,PSOLINE)="LIMIT: "_PSOLIMIT
SET PSOLINE=PSOLINE+1
+8 FOR PSOIEN=0:0
SET PSOIEN=$ORDER(^PS(59,PSOIEN))
if 'PSOIEN
QUIT
Begin DoDot:1
+9 if $EXTRACT($PIECE(^PS(59,PSOIEN,0),U),1,2)="ZZ"
QUIT
+10 IF $GET(^PS(59,PSOIEN,"I"))
if $PIECE(^PS(59,PSOIEN,"I"),U)'>DT
QUIT
+11 SET PSOLOW=$PIECE($GET(^PS(59,PSOIEN,3)),U,1)
SET PSOMAX=$PIECE($GET(^PS(59,PSOIEN,3)),U,2)
SET PSOLAST=$PIECE($GET(^PS(59,PSOIEN,3)),U,3)
+12 SET PSODIFF=PSOMAX-PSOLAST
+13 ;RTW added to check to see if a site sorts Narcotics separately.
SET PSOSORT=$PIECE($GET(^PS(59,PSOIEN,2)),U,1)
+14 ;RTW
IF PSODIFF<PSOLIMIT
IF ($GET(PSOSORT))
DO WARN("NARCOTIC")
+15 SET PSOLOW=$PIECE($GET(^PS(59,PSOIEN,8)),U,1)
SET PSOMAX=$PIECE($GET(^PS(59,PSOIEN,8)),U,2)
SET PSOLAST=$PIECE($GET(^PS(59,PSOIEN,8)),U,3)
+16 SET PSODIFF=PSOMAX-PSOLAST
+17 IF PSODIFF<PSOLIMIT
DO WARN("PRESCRIPTION #")
End DoDot:1
+18 ;
+19 if PSOLINE>2
Begin DoDot:1
+20 SET $PIECE(^TMP("PSOEOPNW",0),U,2)=$$FMTE^XLFDT($$NOW^XLFDT,"1M")
+21 SET $PIECE(^TMP("PSOEOPNW",0),U,4)=PSOLIMIT
+22 SET XMSUB="End of Prescribing Numbering WARNING"
+23 SET (XMDUZ,DUZ)=.5
+24 SET XMTEXT="^TMP($J)"
+25 SET XMY("G.PHARMACY SUPERVISORS")=""
+26 SET XMINSTR("FLAGS")="P"
+27 DO SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.XMINSTR)
End DoDot:1
+28 GOTO EXIT
WARN(PSOFOO) ;
+1 SET ^TMP($JOB,PSOLINE)=""
SET PSOLINE=PSOLINE+1
+2 SET ^TMP($JOB,PSOLINE)="SITE: "_$PIECE(^PS(59,PSOIEN,0),U)
SET PSOLINE=PSOLINE+1
+3 SET ^TMP($JOB,PSOLINE)=PSOFOO_" LOWER BOUND : "_PSOLOW
SET PSOLINE=PSOLINE+1
+4 SET ^TMP($JOB,PSOLINE)=PSOFOO_" UPPER BOUND : "_PSOMAX
SET PSOLINE=PSOLINE+1
+5 SET ^TMP($JOB,PSOLINE)="LAST "_PSOFOO_" ISSUED : "_PSOLAST
SET PSOLINE=PSOLINE+1
+6 SET ^TMP($JOB,PSOLINE)="There are "_PSODIFF_" Numbers left, a new series needs to be defined."
SET PSOLINE=PSOLINE+1
+7 IF PSODIFF<250
SET ^TMP($JOB,PSOLINE)="*** EXTREMELY LOW ***"
SET PSOLINE=PSOLINE+1
+8 QUIT
EXIT ;
+1 KILL %ZIS,PSODIFF,PSOFOO,PSOIEN,PSOLAST,PSOLIMIT,PSOLINE,PSOLOW,PSOMAX,POP,XMDUZ,XMINSTR,XMSUB
+2 KILL XMTEXT,XMY,ZTRTN,^TMP($JOB),^TMP("PSOEOPNW")
+3 if $DATA(ZTQUEUED)
DO KILL^%ZTLOAD
+4 DO ^%ZISC
QUIT
