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

PSOHELP1.m

Go to the documentation of this file.
  1. PSOHELP1 ;BIR/SAB-OUTPATIENT HELP TEXT/UTILITY ROUTINE 2 ;11/09/92
  1. ;;7.0;OUTPATIENT PHARMACY;**23,36,88,146,227,222,408,444**;DEC 1997;Build 34
  1. ;External reference ^DIC(19.2 supported by DBIA 1472
  1. ;External reference ^PSDRUG( supported by DBIA 221
  1. ;External reference ^PS(55 supported by DBIA 2228
  1. ;External reference $$MXDAYSUP^PSSUTIL1 supported by DBIA 6229
  1. ;
  1. 2001 N PSOHLP S PSOHLP(1,"F")="!!"
  1. S PSOHLP(1)="Enter the lowest prescription number for this site."
  1. S PSOHLP(2,"F")="!"
  1. S PSOHLP(2)="If this is the first time you are entering this field,"
  1. S PSOHLP(3,"F")="!"
  1. S PSOHLP(3)="you should pick a number LARGER than the last prescription number used."
  1. S PSOHLP(4,"F")="!!"
  1. D WRITE
  1. Q
  1. ;
  1. 2002 N PSOHLP S PSOHLP(1,"F")="!!"
  1. S PSOHLP(1)="Enter the largest acceptable prescription number for this site."
  1. S PSOHLP(2,"F")="!"
  1. S PSOHLP(2)="The difference between this number and the lowest prescription"
  1. S PSOHLP(3,"F")="!"
  1. S PSOHLP(3)="number should be substantial. The system will not allow numbers"
  1. S PSOHLP(4,"F")="!"
  1. S PSOHLP(4)="larger than the one you choose. It will give a warning message"
  1. S PSOHLP(5,"F")="!"
  1. S PSOHLP(5)="and not allow entry of any more prescriptions."
  1. S PSOHLP(6,"F")="!!"
  1. D WRITE
  1. Q
  1. ;
  1. 2003 N PSOHLP S PSOHLP(1,"F")="!!"
  1. S PSOHLP(1)="Enter the last prescription number used."
  1. S PSOHLP(2,"F")="!"
  1. S PSOHLP(2)="If you are entering this for the first time, this number"
  1. S PSOHLP(3,"F")="!"
  1. S PSOHLP(3)="should be the same as the number you entered for LOW RX#."
  1. S PSOHLP(4,"F")="!"
  1. S PSOHLP(4)="The system will take this number, increment it by one"
  1. S PSOHLP(5,"F")="!"
  1. S PSOHLP(5)="until it finds a number that has not been used, and then"
  1. S PSOHLP(6,"F")="!"
  1. S PSOHLP(6)="use that number for the next prescription."
  1. S PSOHLP(7,"F")="!!"
  1. D WRITE
  1. Q
  1. WRITE ;EN^DDIOL call
  1. D EN^DDIOL(.PSOHLP) K PSOHLP
  1. Q
  1. AUTOQ ;entry point to queue all background jobs
  1. D:0 RESET1^PSOTPHL1 ;placed out of order by PSO*7*227
  1. D AUTO^PSOAUTOC ;ques auto cancel job
  1. D SETUP^PSOAUTOC ;ques nightly cost compile
  1. D SETUP1^PSOAUTOC ;ques nightly mgmt compile
  1. D QUP,CLO ;ques amis compile
  1. D SETUP^PSOHLEXP ;ques exipration status update
  1. D AUTO^PSOSUDEL ;ques job to deleted rxs printed from 52.5
  1. D AUTO^PSOSPML0 ;ques job to transmit CS Rx's to the states
  1. CLO K Y,C,D,D0,DI,DQ,DA,DIE,DR,DIC,Y,X,PSOTM,PSOOPTN,%DT,PSOPTN
  1. Q
  1. QUP K %DT,DIC,DTOUT S DIC(0)="XZM",DIC="^DIC(19.2,",X="PSO AMIS COMPILE" D ^DIC
  1. I +Y>0 D EDIT^XUTMOPT("PSO AMIS COMPILE") G CLO
  1. D RESCH^XUTMOPT("PSO AMIS COMPILE","","","24H","L"),EDIT^XUTMOPT("PSO AMIS COMPILE")
  1. Q
  1. EXP ;reset "P","A" xref in 55 from cancel option
  1. Q:$G(REA)="C"
  1. S PCD=+$P($G(^PSRX(DA,3)),"^",5) I 'PCD D K EXP,PCD,IFN Q
  1. .S (IFN,EXP)=0
  1. .F S EXP=$O(^PS(55,PSODFN,"P","A",EXP)) Q:'EXP F S IFN=$O(^PS(55,PSODFN,"P","A",EXP,IFN)) Q:'IFN I IFN=DA K ^PS(55,PSODFN,"P","A",EXP,DA) S ^PS(55,PSODFN,"P","A",$P(^PSRX(DA,2),"^",6),DA)=""
  1. K ^PS(55,PSODFN,"P","A",PCD,DA) S ^PS(55,PSODFN,"P","A",$P(^PSRX(DA,2),"^",6),DA)="",$P(^PSRX(DA,3),"^",5)=""
  1. K PCD Q
  1. SREF ;set "P","A" xref in 55 from fileman
  1. I $P($G(^PSRX(X,"STA")),"^")=12,'$P($G(^PSRX(X,3)),"^",5) D Q
  1. .F PX=0:0 S PA=$O(^PSRX(X,"A",PX)) Q:'PX S:$P(^PSRX(X,"A",PX,0),"^",2)="C" PCD=$P($P(^PSRX(X,"A",PX,0),"^"),".")
  1. .I $G(PCD) S ^PS(55,DA(1),"P","A",PCD,X)="",$P(^PSRX(X,3),"^",5)=PCD
  1. .E S:$P($G(^PSRX(X,2)),"^",6) ^PS(55,DA(1),"P","A",$P(^PSRX(X,2),"^",6),X)=""
  1. .K PCD,PX
  1. I $P($G(^PSRX(X,"STA")),"^")=12,$P($G(^PSRX(X,3)),"^",5) S ^PS(55,DA(1),"P","A",$P(^PSRX(X,3),"^",5),X)="" Q
  1. S:$P($G(^PSRX(X,2)),"^",6) ^PS(55,DA(1),"P","A",$P(^PSRX(X,2),"^",6),X)=""
  1. Q
  1. KREF ;kill "P","A" xref in 55 from fileman
  1. K:+$P($G(^PSRX(X,2)),"^",6) ^PS(55,DA(1),"P","A",+$P(^PSRX(X,2),"^",6),X)
  1. I $P($G(^PSRX(X,"STA")),"^")=12,'$P($G(^PSRX(X,3)),"^",5) D K PCD,PX Q
  1. .F PX=0:0 S A=$O(^PSRX(X,"A",PX)) Q:'PX S:$P(^PSRX(X,"A",PX,0),"^",2)="C" PCD=$P($P(^PSRX(X,"A",PX,0),"^"),".")
  1. .I $G(PCD) K ^PS(55,DA(1),"P","A",PCD,X)
  1. I $P($G(^PSRX(X,"STA")),"^")=12,$P($G(^PSRX(X,3)),"^",5) K ^PS(55,DA(1),"P","A",$P(^PSRX(X,3),"^",5),X)
  1. Q
  1. DAYS ; INPUT TRANSFORM for DAYS SUPPLY field (#8) in the PRESCRIPTION file (#52)
  1. N PSMAX,DRUGIEN
  1. S DRUGIEN=+$P(^PSRX(DA,0),"^",6)
  1. I $P($G(^PSDRUG(DRUGIEN,0)),"^",4),$P(^PSRX(DA,0),"^",7)/X>$P($G(^PSDRUG(DRUGIEN,0)),"^",4) D EN^DDIOL("Max Daily Dose of "_$P($G(^(0)),"^",4)_" Exceeded","","$C(7),!?5") D EN^DDIOL(" ","","!")
  1. S PSDAYS=$P(^PSRX(DA,0),"^",8),PSRF=+$P(^(0),"^",9),PTST=$G(^PS(53,$P(^(0),"^",3),0)),PTDY=$P(PTST,"^",3),PTRF=$P(PTST,"^",4),PSODEA=$P(^PSDRUG($P(^PSRX(DA,0),"^",6),0),"^",3)
  1. S CS=0 I (PSODEA[2)!(PSODEA[3)!(PSODEA[4)!(PSODEA[5) S CS=1
  1. I $G(CLOZPAT)=1,'PSRF,X>14 K X D EN^DDIOL(" 14 Day Supply Max for Clozapine Prescriptions.","","$C(7),!!") Q
  1. I $G(CLOZPAT)=0,'PSRF,X>7 K X D EN^DDIOL(" 7 Day Supply Max for Clozapine Prescriptions.","","$C(7),!!") Q
  1. I $G(CLOZPAT)=1,X'=7,PSRF K X D EN^DDIOL(" Day Supply Must Equal 7 with 1 refill for Clozapine Prescriptions.","","$C(7),!!") Q
  1. I $G(CLOZPAT)=1,'PSRF,X>14 K X D EN^DDIOL(" 14 Day Supply Max for Clozapine Prescriptions.","","$C(7),!!") Q
  1. I $G(CLOZPAT)=2,'PSRF,X>28 K X D EN^DDIOL(" 28 Day Supply Max for Clozapine Prescriptions.","","$C(7),!!") Q
  1. I $G(CLOZPAT)=2,PSRF=1,X>14 K X D EN^DDIOL(" Day Supply Must Equal 14 with 1 refill for Clozapine Prescriptions.","","$C(7),!!") Q
  1. I $G(CLOZPAT)=2,PSRF=3,X>7 K X D EN^DDIOL(" Day Supply Must Equal 7 with 3 refill for Clozapine Prescriptions.","","$C(7),!!") Q
  1. ;
  1. ; Checking Maximum Day Supply value for the Drug
  1. I X>$$MXDAYSUP^PSSUTIL1(DRUGIEN) D Q
  1. . K X D EN^DDIOL(" DAYS SUPPLY exceeds the maximum allowed ("_$$MXDAYSUP^PSSUTIL1(DRUGIEN)_") for "_$$GET1^DIQ(50,DRUGIEN,.01)_".","","$C(7),!!") Q
  1. ;
  1. ; Retrieving the Maximum Number of Refills allowed
  1. S MAX=$$MAXNUMRF^PSOUTIL(DRUGIEN,X,+$P(^PSRX(DA,0),"^",3),.CLOZPAT)
  1. I PSRF>MAX S DS=X D
  1. .D FULL^VALM1,EN^DDIOL(PSRF_" refills are not correct for a "_DS_" day supply.","","$C(7),!!")
  1. .D EN^DDIOL("Please enter correct # of refills for a "_DS_" day supply. Max refills allowed is "_MAX_".","","!") D EN^DDIOL(" ","","!")
  1. .K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,X,Y,DIRUT S VALMBCK="R"
  1. K PSTMAX,DS D EDSTAT^PSOUTLA
  1. K MAX,DAYS,PSDAYS,PSODEA,PSOX,PSOX1,PSDY,PSDY1,DEA,CS,PTST,PSRF,PTRF,PTDY
  1. Q
  1. DAYS1 ; INPUT TRANSFORM for DAYS SUPPLY field (#1.1) in the REFILL sub-file (#52.1) of the PRESCRIPTION file (#52)
  1. N PSRMAX,DRUGIEN,CS
  1. S DRUGIEN=+$P(^PSRX(DA(1),0),"^",6)
  1. S PSRF=$P(^PSRX(DA(1),0),"^",9),PTST=$G(^PS(53,$P(^(0),"^",3),0)),PTDY=$P(PTST,"^",3),PTRF=$P(PTST,"^",4)
  1. S PSDAYS=$P(^PSRX(DA(1),1,DA,0),"^",10),PSODEA=$P(^PSDRUG(DRUGIEN,0),"^",3)
  1. S CS=0 I (PSODEA[2)!(PSODEA[3)!(PSODEA[4)!(PSODEA[5) S CS=1
  1. ;
  1. ; Checking Maximum Day Supply value for the Drug
  1. I X>$$MXDAYSUP^PSSUTIL1(DRUGIEN) D Q
  1. . K X D EN^DDIOL(" DAYS SUPPLY exceeds the maximum allowed ("_$$MXDAYSUP^PSSUTIL1(DRUGIEN)_") for "_$$GET1^DIQ(50,DRUGIEN,.01)_".","","$C(7),!!") Q
  1. ;
  1. K DS,MAX,DAYS,PSDAYS,PSODEA,PSOX,PSOX1,PSDY,PSDY1,DEA,CS,PTST,PSRF,PTDY,PTRF
  1. Q