- 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 Mar 13, 2025@21:32:23 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
