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

APSQCK1.m

Go to the documentation of this file. 
  1. APSQCK1 ;IHS/ASDS/ENM/POC - CONT OF APSQCK NON FORMULARY CALL  [ 06/07/2001  10:56 AM ]
  1.  ;;6.0;IHS PHARMACY MODIFICATIONS;**3**;FEB 20, 2001
  1.  ;PROGRAM FOR ALL CALLS TO NON FORMULARY REQUEST [ 01/22/01  10:42 PM ]
  1.  ;CONTINUATION FROM APSQCK
  1.  ;CALLS FROM PSORXDL PSON52 PSORN52 ROUTINES
  1.  ;A XREF LOOKUP TO KEEP PROVIDER FROM GIVING SAME DRUG TO SAME PERSON ON SAME DAY OR HAVE A RECORD OPEN FOR PATIENT AND A SAME DRUG
  1.  ;D EN^XBVK("APSQC")
  1.  Q
  1. CK ;EP
  1.  K APSQ("PAT"),APSQ("DRUG"),APSQ("DT")
  1.  S JOB=$J
  1.  ;M APSQC=^TMP("DDS",JOB,+DDS,"F"_DDSFILE,"11,") ;)_")") ;,"11,"_")"))
  1.  M APSQC=^TMP("DDS",JOB,+DDS,"F"_DDSFILE,DDSDA) ;)_")") ;,"11,"_")"))
  1.  ;W ABC
  1.  S APSQ("PAT")=$G(APSQC(2,"D"))
  1.  Q:APSQ("PAT")']""
  1.  ;S APSQ("DRUG")=$G(APSQC(3,"D"))
  1.  S APSQ("DRUG")=$G(DDSY)
  1.  Q:APSQ("DRUG")']""
  1.  S APSQ("DT")=$G(APSQC(1,"D"))
  1.  Q:APSQ("DT")']""
  1.  I $D(^APSQNF("M",APSQ("PAT"),APSQ("DRUG"),APSQ("DT"))) S DDSERROR=1 D 
  1.  .S MSG("DIHELP",1)="THIS PATIENT ALREADY HAS A NON FORMULARY REQUEST FOR THIS DRUG TODAY" D MSG^DIALOG("WH","",60,"","MSG")
  1.  .Q
  1.  I $D(DDSERROR) D EN^XBVK("APSQ") Q
  1.  ;
  1.  ;CANT HAVE ANY RECORD FOR THIS PATIENT AND THIS DRUG "OPEN"
  1.  S APSQ("QUIT")=0
  1.  S APSQ("DT")=0 F  S APSQ("DT")=$O(^APSQNF("M",APSQ("PAT"),APSQ("DRUG"),APSQ("DT"))) Q:(APSQ("DT")="")!APSQ("QUIT")  S APSQ("RECIEN")=^(APSQ("DT")) D
  1.  .Q:APSQ("RECIEN")=""
  1.  .S APSQ("CLOSED")=$P($G(^APSQNF(APSQ("RECIEN")),1),U,8)
  1.  .Q:APSQ("CLOSED")]""  ;RECORD CLOSED
  1.  .S DDSERROR=1,APSQ("QUIT")=1
  1.  .Q
  1.  D EN^XBVK("APSQ")
  1.  Q
  1. LOOK ;EP LOOK UP AN ENTRY AND DO SOMETHING
  1.  ;S LOOK TO PRINT TO PRINT OR XMB TO SEND MESSAGE
  1.  W !,"YOU MAY LOOK UP ENTRIES BY CONTROL #, PATIENT, DRUG, OR DATE"
  1.  K DIC
  1.  S DIC="^APSQNF(",DIC(0)="AEMO"
  1.  S DIC("A")="WHAT NON FORMULARY REQUEST DO YOU WANT TO SELECT? "
  1.  D ^DIC
  1.  ;S DUZ=DUZSAVE K DUZSAVE
  1.  ;G:Y<1 EXIT
  1.  ;I (Y<1)!($D(DTOUT))!($D(DUOUT)) G EXIT
  1.  I (Y<1)!($D(DTOUT))!($D(DUOUT))!(+Y=0) G EXIT ;IHS/OKCAO/POC 3/12/2001
  1.  E  S DA=+Y D WRITE,@LOOK
  1.  G EXIT
  1.  Q
  1.  ;
  1.  ;BELOW CAN SEND A MESSAGE TO WHOEVER FOR THE NON FORMULARY REQUEST
  1. WRITE ;
  1.  K ^UTILITY("DIQ1",$J)
  1.  S DR=".01:999",DIQ(0)="E"
  1.  D EN^XBNEW("EN^DIQ1","DIC;DR;DA;DIQ*") ;HAVE WE SOME CONFLICT HERE 1/21/2001
  1.  ;D EN^DIQ1 ;TO GET WRITTEN TO ^UTILITY("DIQ1",$J,ETC
  1.  M DD=^UTILITY("DIQ1",$J)
  1.  S FILE=$O(DD(""))
  1.  S DA=$O(DD(FILE,""))
  1.  S FIELD=0 F I=1:1 S FIELD=$O(DD(FILE,DA,FIELD)) Q:FIELD=""  D
  1.  .S NAME=$P(@("^DD("_FILE_","_FIELD_",0)"),"^",1)
  1.  .I $D(DD(FILE,DA,FIELD,"E")) S NAME=NAME_":"_DD(FILE,DA,FIELD,"E")
  1.  .S ARRAY(FIELD)=NAME
  1.  .S ARRAY(FIELD-.00001)=""
  1.  .S LAST=0,J=FIELD F J=J+.00001:.00001 S LAST=$O(DD(FILE,DA,FIELD,LAST)) Q:LAST'=+LAST  D
  1.  ..S ARRAY(J)=DD(FILE,DA,FIELD,LAST)
  1.  Q
  1. XMB ;SEND TO WHO EVER
  1.  S XMTEXT="ARRAY(" ;THE ABOVE JUST MADE ABOVE BY WRITE
  1.  S XMSUB="NON FORMULARY REQUEST FROM "_$P(^DIC(4,DUZ(2),0),U,1)
  1.  S XMDUZ=$S($D(DUZSAVE):DUZSAVE,1:DUZ)
  1.  D ^XMD
  1.  Q
  1. EXIT ;CLEAN UP TIME
  1.  I $D(DUZSAVE) S DUZ=DUZSAVE K DUZSAVE
  1.  K EXIT
  1.  K OUT,DISP
  1.  K DDSPARM,DDSFILE,DR,DA,DDSSAVE,DDSCHANG
  1.  K ADD,CNT,PERSON,NUM,MORE,SCR,SEQ,IEN,I,FROM,GET,DEL,HIT
  1.  ;K ADD,CNT,PERSON,NUM,MORE,SCR,SEQ,IEN,I,GET,DEL,HIT
  1.  K XMB,XMDUZ
  1.  Q
  1. VAL1 ;EP CALLED FROM SCREENMAN UPON VALIDATING THE FORM APSQ NF PHARMACIST
  1.  ;I MIGHT NOT USE THIS
  1.  S CHECK=$$GET^DDSVALF(8,2,1,"I") ;CHECK IF RPH WANTS TO SAVE FORM
  1.  I CHECK D
  1.  .S HELP(1)="SAVE AND EXIT THE FORM IF YOU WANT TO SAVE YOUR DATA"
  1.  .D HLP^DDSUTL(.HELP)
  1.  .K DDSERROR
  1.  .;S DDSBR="COM"
  1.  .Q
  1.  I 'CHECK D
  1.  .S HELP(1)="*************"
  1.  .S HELP(2)="IF YOU WANT TO SAVE THE FORM"
  1.  .S HELP(3)="CHANGE THE SAVE THE FORM FIELD TO 'YES'"
  1.  .D HLP^DDSUTL(.HELP)
  1.  .K HELP
  1.  .S DDSBR="8"
  1.  .S DDSERROR=1
  1.  .Q
  1.  K CHECK,HELP
  1.  Q
  1. VAL2 ;EP COME HERE FROM SCREENMAN TO SEE IF WANT TO DELETE FORM
  1.  S KILL=$$GET^DDSVALF(20,1,1,"I")
  1.  I KILL S DIK="^APSQNF(" D ^DIK
  1.  ;K KILL,DIK,DA
  1.  K DIK,DA
  1.  Q
  1. VAL3 ;EP COME HERE FROM SCREENMAN TO SEE IF WANT TO DELETE RPH COMMENTS
  1.  S KILL=$$GET^DDSVALF(8,3,1,"I")
  1.  I KILL D  ;
  1.  .S DIE="^APSQNF(",DR="6///@;10///@;11///@;12///@;13///@;14///@;70///@" D ^DIE
  1.  .K DIE,DA
  1.  .Q
  1.  K KILL
  1.  Q
  1. VAL33 ;EP VALIDATION OF SCREENMAN APSQ NF PHARMACIST ...
  1.  S KILL=$$GET^DDSVALF(8,3,1,"I")
  1.  I KILL D  ;
  1.  .S HELP(1)="IF YOU WANT TO SAVE THE PHARMACIST INFORMATION"
  1.  .S HELP(2)="CHANGE 'DELETE THE PHARMACY INFO AND YOUR SIGNATURE' TO 'NO'"
  1.  .S HELP(3)="IF YOU WANT TO DELETE THE PHARMACIST INFO-EXIT THE FORM W/O SAVING"
  1.  .D HLP^DDSUTL(.HELP)
  1.  .K HELP
  1.  .S DDSBR="8"
  1.  .S DDSERROR=1
  1.  .Q
  1.  K KILL
  1.  Q
  1. VAL4 ;EP COME HERE FROM SCREENMAN TO SEE IF WANT TO DELETE RPH COMMENTS
  1.  S KILL=$$GET^DDSVALF(7,2,1,"I")
  1.  I KILL D 
  1.  .S DIE="^APSQNF(",DR="7///@;7.5///@;80///@" D ^DIE
  1.  .K DIE,DA
  1.  .Q
  1.  K KILL
  1.  Q
  1. VAL44 ;EP VALIDATION OF SCREENMAN APSQ NF PHARMACIST ...
  1.  S KILL=$$GET^DDSVALF(7,2,1,"I")
  1.  I KILL D
  1.  .S HELP(1)="IF YOU WANT TO SAVE THE P/T INFORMATION"
  1.  .S HELP(2)="CHANGE 'DELETE THE P/T INFO AND YOUR SIGNATURE' TO 'NO'"
  1.  .S HELP(3)="IF YOU WANT TO DELETE THE P/T INFO-EXIT THE FORM W/O SAVING"
  1.  .D HLP^DDSUTL(.HELP)
  1.  .K HELP
  1.  .S DDSBR="7"
  1.  .S DDSERROR=1
  1.  .Q
  1.  K KILL
  1.  Q
  1. BULL(GOTIT,BULLETIN,XMY) ;SEND A BULLETIN GOTIT IS THE IEN OF APSQNF( AND BULLETIN IS NAME OF BULLETIN
  1.  ;GOTIT IS THE IEN OF NONFORMULARY REQUEST
  1.  ;BULLETIN  IS NAME OF BULLETIN TO USE
  1.  ;WHO IS ADDITIONAL PERSON TO SEND BULLETIN TO
  1.  W !!,"BULLETIN BEING SENT",!!
  1.  ;S GOTIT="SOMETHING"
  1.  S GOTIT="`"_GOTIT ;WANT IEN I THINK
  1.  D FIND^DIC(9009035.1,,".01;2;3;4;4.1;5;5.1;6;6.1;7;7.1;7.5",,GOTIT,,,,,"GET","OUCH")
  1.  M XMB=GET("DILIST","ID",1) ;MAKE IT EASIER TO WORK WITH
  1.  D BULL2
  1.  D BULL1
  1.  Q
  1. BULL1 S XMDUZ=.5
  1.  S XMB=BULLETIN
  1.  D ^XMB
  1.  K XMY
  1.  Q
  1.  ;
  1. BULL2 ;ADD ANY EXTRA PEOPLE TO BULLETIN
  1.  W !,"ADDITIONAL ENTRIES MAY BE ADDED TO THE BULLETIN"
  1.  W !,"REMEMBER ENTRIES HAVE BEEN ADDED FOR YOURSELF AND THE BULLETIN MAILGROUPS"
  1. DIC S DIC(0)="AEMQ"
  1.  S DIC="^VA(200,"
  1.  S DIC("S")="I ($P(^(0),U,3)'="""")&($S($P(^(0),U,11)]"""":$P(^(0),U,11),1:9999999)>DT)"
  1.  S DIC("A")="ADDITIONAL 'LOCAL USER' TO THE BULLETIN //"
  1.  D ^DIC
  1.  I Y>0 S XMY(+Y)="" G DIC
  1.  K DIC
  1.  Q
  1.  S XMZ=$$FIND1^DIC(3.6,"","MX",BULLETIN)
  1.  S XMDUZ=.5
  1.  S XMDUN=""
  1.  D DEST^XMA21
  1.  ;GETS XMY ARRAY
  1.  ;W !,"SOME STUFF HERE"
  1.  Q
  1. PASS(PROV) ;EP CHECK IF THIS IS A VALID NEW PERSON TO LOOK AT THIS ENTRY
  1.  Q:'$G(PROV) 1
  1.  ;PROV WOULD BE THE REQUESTING PROVIDER.  WOULD TAKE THIS PROV
  1.  ;AND LOOK IN A NEW FILE WITH WHO CAN SIGN OFF AT VARIOUS STAGES
  1.  ;CHECK WHO CAN SIGN OFF AGAINST DUZ
  1.  ;AND RETURN THE QUIT VALUE AS 1 OR 0
  1.  Q 1
  1.  ;
  1. PRINT ;PRINT OR BROWSE A NON FORMULARY REQUEST
  1.  K DIR
  1.  S DIR(0)="SO^P:PRINT NON FORMULARY REQUEST;B:BROWSE NON FORMULARY REQUST"
  1.  S DIR("A")="DO YOU WANT TO "
  1.  S DIR("B")="PRINT"
  1.  W !
  1.  D ^DIR
  1.  K DIR
  1.  Q:($D(DTOUT))!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))  ;CHECK THIS ***
  1.  I $E($G(X))="P" D PRT Q
  1.  I $E($G(X))="B" D BROWSE Q
  1.  Q
  1. BROWSE ; BROWSE IT
  1.  ;NEED ENTRY XB... IN LIST TEMPLATE FILE
  1.  S TOP="NON FORMULARY REQUEST FOR "_$P(^DPT($P(^APSQNF(DA,0),U,3),0),U)
  1.  ;D VIEWR^XBLM("EN^DIQ","NON FORMULARY REQUEST FOR "_TOP)
  1.  D VIEWR^XBLM("PRT1^APSQCK","NON FORMULARY REQUEST FOR "_TOP)
  1.  Q
  1.  ;
  1. PRT ;PRINT IT
  1.  S %ZIS="QM" D ^%ZIS G EXIT:POP
  1.  I $D(IO("Q")) D  D ^%ZTLOAD D HOME^%ZIS K IO("Q") Q
  1.  .S ZTRTN="PRT1^APSQCK",ZTDESC="PRINT OF ONE NON FORMULARY REQUEST"
  1. PRT1 ;EP
  1.  S (END,NUMPT,PAGE)=0
  1.  U IO
  1.  D @("HDR"_(2-($E(IOST,1,2)="C-")))
  1.  S ARRAY=0 F  S ARRAY=$O(ARRAY(ARRAY)) Q:ARRAY=""!END  D
  1.  .W !,ARRAY(ARRAY)
  1.  .I ($Y+5)>IOSL D HDR
  1.  .Q
  1.  D ^%ZISC Q
  1. HDR I $E(IOST,1,2)="C-" W !,"PRESS RETURN TO CONTINUE OR '^' TO EXIT " R X:DTIME S END='$T!(X="^") Q:END  ;
  1. HDR1 W @IOF
  1. HDR2 S TOP="NON FORMULARY REQUEST FOR "_$P(^DPT($P(^APSQNF(DA,0),U,3),0),U)
  1.  S LENG=$L(TOP)
  1.  S PAGE=PAGE+1 W ?(IOM-LENG/2),TOP,?(IOM-12),"PAGE:  ",$J(PAGE,3)
  1.  Q
  1.  ;
  1. RX ;EP COMES FROM PSODRG TO CHECK IF NON FORMULARY REQUEST FOR NF DRUG
  1.  ;PSODFN IS PATIENT,PSODRUG("IEN") IS DRUG 
  1.  ;ROUTINES PSODRG PSORXI MODIFIED 
  1.  W !,"CHECKING NON FORMULARY INFORMATION...",!
  1.  Q:('$D(PSODRUG("IEN"))!('$D(PSODFN)))  ;I HAVEN'T A CLUE
  1.  Q:'$P(^PSDRUG(PSODRUG("IEN"),0),U,9)  ;NOT A NF DRUG
  1.  S NFRXDRUG=PSODRUG("IEN")_";PSDRUG(" ;REMEMBER THIS FIELD IS VARIABLE
  1.  S NFRXPT=PSODFN
  1.  S NFRXDATE=$O(^APSQNF("M",NFRXPT,NFRXDRUG,""),-1)
  1.  I 'NFRXDATE W !,"NO NON FORMULARY REQUESTS EXISTS FOR THIS DRUG" G NFRXEND
  1.  S NFRXIEN=^APSQNF("M",NFRXPT,NFRXDRUG,NFRXDATE)
  1.  G:'NFRXIEN NFRXEND W !,"NON FORMULARY REQUEST "_$P(^APSQNF(NFRXIEN,0),U)_" EXISTS"
  1.  S NFRXSEC=$G(^APSQNF(NFRXIEN,1)) ;SECOND NODE
  1.  S NFRXREF=$P(NFRXSEC,U,15),NFRXAPP=$P(NFRXSEC,U,8)
  1.  I NFRXREF W !,"RX# "_+$G(^PSRX(NFRXREF,0))_" HAS BEEN FILLED PREVIOUSLY USING THIS NON FORMULARY REQUEST"
  1.  W !,"THIS NON FORMULARY REQUEST STATUS IS "_$S(NFRXAPP=1:"APPROVED",NFRXAPP=0:"NOT APPROVED",1:"NOT ACTED UPON YET")
  1. NFRXEND ;FINISH
  1.  W !
  1.  D ASK
  1.  ;S:('NFRXREF)&(NFRXAPP) NFRXAOK=1
  1.  D EN^XBVK("NFRX")
  1.  Q
  1. ASK ;ASK WHAT IS TO BE DONE
  1.  ;LETS DO REVERSE VIDEO
  1.  S X="IORVON;IORVOFF" D ENDR^%ZISS
  1.  ;FIRST WRITE MESSAGES
  1.  S I="" F  S I=$O(AZO(I)) Q:I=""  W:I="MESS" IORVON W !,*7,AZO(I) W:I="MESS" IORVOFF
  1.  ;S DIR("A")="WHAT IS YOUR POISON?  "
  1.  S DIR("A")="WHAT IS YOUR CHOICE?  "
  1.  S DIR("A",1)="1  DO YOU WANT TO DELETE THIS DRUG?"
  1.  S DIR("A",2)="2  DO AN INTERVENTION?"
  1.  S DIR("A",3)="3  DO BOTH 1 AND 2?"
  1.  S DIR("A",4)="4  JUST CONTINUE?"
  1.  S DIR("B")=1
  1.  S DIR(0)="N^1:4:0"
  1.  D ^DIR
  1.  ;IF (Y="")!(Y["^") S Y=1
  1.  IF $D(DIRUT)!($D(DIROUT)) S Y=1
  1.  K DIR,DTOUT,DIRUT,DUOUT,DIROUT
  1.  D @Y
  1.  QUIT
  1.  ;
  1. 1 ;DELETE THE DRUG
  1.  S PSORX("DFLG")=1,DGI=""
  1.  QUIT
  1. 2 ;DO AN INTERVENTION
  1.  S PSORX("INTERVENE")=4,DGI=""
  1.  ;PSORXI WAS MODIFIED
  1.  ;LOOK AT THIS 4/13/98 IHS/OKCAO/POC
  1.  QUIT
  1. 3 ;DO BOTH 1 AND 2
  1.  D 2,1
  1.  QUIT
  1. 4 ;DO NOTHING
  1.  QUIT
  1. RXSET ;EP SET THE REFERENCE RX FIELD
  1.  ;CALLED FROM PSON52 AND PSOR52
  1.  ;WITH NFRXIEN DEFINED AS PSRX IEN
  1.  ;QUIT
  1.  D RXSET1,STOP
  1.  Q
  1. RXSET1 S NFRXDRUG=$P(^PSRX(NFRXIEN,0),U,6) ;DRUG IEN
  1.  Q:'$P(^PSDRUG(NFRXDRUG,0),U,9)  ;NOT NON FORMULARY
  1.  S NFRXDRUG=NFRXDRUG_";PSDRUG(" ;REMEMBER THIS FIELD IS VARIABLE
  1.  S NFRXPT=PSODFN
  1.  S NFRXDATE=$O(^APSQNF("M",NFRXPT,NFRXDRUG,""),-1) I NFRXDATE S NFRXNON=^(NFRXDATE)
  1.  Q:'NFRXDATE  ;NO NON FORMULARY REQUEST
  1.  Q:'NFRXNON  ;I HAVEN'T A CLUE
  1.  I '$P($G(^APSQNF(NFRXNON,1)),U,15) S DIE="^APSQNF(",DA=NFRXNON,DR="14///"_"`"_NFRXIEN D ^DIE K DIE ;ONLY SET IF FIELD NOT NULL
  1.  Q
  1. RXSETK ;EP KILL PRESCRIPTION REFERENCE IF RX DELETED
  1.  ;VARIABLE NFRXIEN PASSED FROM DA IN PSORXDL
  1.  ;S KILL=$O(^APSQNF(XREF,NFRXIEN,""))
  1.  S KILL=$O(^APSQNF("RX",NFRXIEN,""))
  1.  I KILL S DIE="^APSQNF(",DA=KILL,DR="14///@" D ^DIE K DIE
  1.  D STOP
  1.  Q
  1. STOP D EN^XBVK("NFRX")
  1.  Q