APSQNF ;IHS/ASDS/ENM/POC - PROGRAM TO DEAL WITH NON FORMULARY REQUEST
;;6.0;IHS PHARMACY MODIFICATIONS;**3**;FEB 20, 2001
;FIRST CHECK IF IEN OF DRUG AND PT DFN
;!!! DONT FORGET TO SET FLAG APSQNF TO SET FIELD RX POINTER WHEN PRINT
Q:('$D(PSODFN))!('$D(PSODRUG("IEN")))
Q:'($P($G(^PSDRUG(PSODRUG("IEN"),0)),"^",9)) ;CHECK STATUS OF NF FIELD
INIT S U="^"
D NF(PSODRUG("IEN"),PSODFN) ;CHECK FOR ANY NON FORMULARY REQUESTS FOR THIS PATIENT AND DRUG IN FORM OF APSQDT ARRAY
;
I APSQLAST=0 W !,"A NON FORMULARY REQUEST DOES NOT EXISTS FOR THIS PATIENT FOR THIS DRUG" S APSQDIR=1
I APSQLAST>0,$P(APSQLAST(APSQLAST),U,2) W !,"A NON FORMULARY REQUEST EXISTS FOR THIS PATIENT DATED "_$$FMTE^XLFDT(9999999-APSQLAST),!,"BUT PRESCRIPTION # ",+^PSRX(APSQLAST(APSQLAST,U,2),0)," HAS BEEN FILLED FOR IT" S APSQDIR=2
I APSQLAST>0,'$P(APSQLAST(APSQLAST),U,2) W !,"NON FORMULARY REQUEST ON FILE FOR THIS PATIENT AND DRUG DATED "_$$FMTE^XLFDT(9999999-APSQLAST) S APSQDIR=3
D DIR
;W !,"GOT HERE"
NF(DRUG,PATIENT) ;CHECKS FOR NON FORMULARY REQUESTS FOR THIS PATIENT AND DRUG
K APSQDT
I '$D(^PSNF("M",DRUG,PATIENT)) S APSQLAST=0,APSQLAST(APSQLAST)="NONE" Q
S APSQDAT="" F S APSQDAT=$O(^PSNF("M",DRUG,PATIENT,APSQDAT)) Q:APSQDAT="" D ;
.S APSQIEN=^PSNF("M",DRUG,PATIENT,APSQDAT)
.S APSQRX=$P(^PSNF(APSQIEN,0),U,13)
.S APSQDT(9999999-APSQDAT)=APSQIEN_U_APSQRX ;GOT THE IEN AND IF RX FILLED FOR THIS NON FORMULARY REQUEST
S APSQLAST=$O(APSQDT(""))
S APSQLAST(APSQLAST)=APSQDT(APSQLAST)
K APSQDAT,APSQDT
Q
;
DIR ;ASK QUESTION
Q:APSQDIR=3
S DIR(0)="S^1:ADD A NON-FORMULARY REQUEST ON THE FLY;2:DELETE THE DRUG;3:NOTHING"
S DIR("A")="WHAT DO YOU WANT TO DO?"
S DIR("B")=3
D ^DIR
I $D(DIRUT)!($D(DUOUT))!($D(DTOUT)) S Y=3
K DIR,DIRUT,DUOUT,DTOUT
Q
;
XREF(EN,SETKILL) ;CROSS REFERENCE ROUTINE
Q:'$G(EN) Q:'$G(SETKILL) ;SOMETHING WRONG
S OUTDIEN=$O(^PSDRUG("B","OUTSIDE DRUG",""))
;Q:OUTDIEN="" ;NO OUTSIDE DRUG!!!
I 'OUTDIEN S LOCAL("DIMSG")="NO DRUG ENTRY 'OUTSIDE DRUG'-ENTER ONE!!" D MSG^DIALOG("WM","","","","LOCAL") S DIK="^APSQNF(" D ^DIK K DIK Q
I SETKILL="ADD" D ADD
I SETKILL="KILL" D KILL
Q
ADD ;ADD A XREF
;DRUG FIELD
I EN=.01 I $P(^PSNF(DA,0),U,10),$P(^(0),U,12) D
.I X'=OUTDIEN S ^PSNF("M",X,$P(^(0),U,10),$P(^(0),U,12))=DA Q
.I $P(^PSNF(DA,0),U,2) S ^PSNF("M",X,$P(^(0),U,2),$P(^(0),U,12))=DA
Q
;FREE TEXT FIELD
I EN=1
KILL ;KILL A XREF
I EN=.01 I $P(^PSNF(DA,0),U,10),$P(^(0),U,12) D
.I X'=OUTDIEN K ^PSNF("M",X,$P(^(0),U,10),$P(^(0),U,12)) Q
.I $P(^PSNF(DA,0),U,2) K ^PSNF("M",X,$P(^(0),U,2),$P(^(0),U,12))
Q
APSQNF ;IHS/ASDS/ENM/POC - PROGRAM TO DEAL WITH NON FORMULARY REQUEST
+1 ;;6.0;IHS PHARMACY MODIFICATIONS;**3**;FEB 20, 2001
+2 ;FIRST CHECK IF IEN OF DRUG AND PT DFN
+3 ;!!! DONT FORGET TO SET FLAG APSQNF TO SET FIELD RX POINTER WHEN PRINT
+4 IF ('$DATA(PSODFN))!('$DATA(PSODRUG("IEN")))
QUIT
+5 ;CHECK STATUS OF NF FIELD
IF '($PIECE($GET(^PSDRUG(PSODRUG("IEN"),0)),"^",9))
QUIT
INIT SET U="^"
+1 ;CHECK FOR ANY NON FORMULARY REQUESTS FOR THIS PATIENT AND DRUG IN FORM OF APSQDT ARRAY
DO NF(PSODRUG("IEN"),PSODFN)
+2 ;
+3 IF APSQLAST=0
WRITE !,"A NON FORMULARY REQUEST DOES NOT EXISTS FOR THIS PATIENT FOR THIS DRUG"
SET APSQDIR=1
+4 IF APSQLAST>0
IF $PIECE(APSQLAST(APSQLAST),U,2)
WRITE !,"A NON FORMULARY REQUEST EXISTS FOR THIS PATIENT DATED "_$$FMTE^XLFDT(9999999-APSQLAST),!,"BUT PRESCRIPTION # ",+^PSRX(APSQLAST(APSQLAST,U,2),0)," HAS BEEN FILLED FOR IT"
SET APSQDIR=2
+5 IF APSQLAST>0
IF '$PIECE(APSQLAST(APSQLAST),U,2)
WRITE !,"NON FORMULARY REQUEST ON FILE FOR THIS PATIENT AND DRUG DATED "_$$FMTE^XLFDT(9999999-APSQLAST)
SET APSQDIR=3
+6 DO DIR
+7 ;W !,"GOT HERE"
NF(DRUG,PATIENT) ;CHECKS FOR NON FORMULARY REQUESTS FOR THIS PATIENT AND DRUG
+1 KILL APSQDT
+2 IF '$DATA(^PSNF("M",DRUG,PATIENT))
SET APSQLAST=0
SET APSQLAST(APSQLAST)="NONE"
QUIT
+3 ;
SET APSQDAT=""
FOR
SET APSQDAT=$ORDER(^PSNF("M",DRUG,PATIENT,APSQDAT))
IF APSQDAT=""
QUIT
Begin DoDot:1
+4 SET APSQIEN=^PSNF("M",DRUG,PATIENT,APSQDAT)
+5 SET APSQRX=$PIECE(^PSNF(APSQIEN,0),U,13)
+6 ;GOT THE IEN AND IF RX FILLED FOR THIS NON FORMULARY REQUEST
SET APSQDT(9999999-APSQDAT)=APSQIEN_U_APSQRX
End DoDot:1
+7 SET APSQLAST=$ORDER(APSQDT(""))
+8 SET APSQLAST(APSQLAST)=APSQDT(APSQLAST)
+9 KILL APSQDAT,APSQDT
+10 QUIT
+11 ;
DIR ;ASK QUESTION
+1 IF APSQDIR=3
QUIT
+2 SET DIR(0)="S^1:ADD A NON-FORMULARY REQUEST ON THE FLY;2:DELETE THE DRUG;3:NOTHING"
+3 SET DIR("A")="WHAT DO YOU WANT TO DO?"
+4 SET DIR("B")=3
+5 DO ^DIR
+6 IF $DATA(DIRUT)!($DATA(DUOUT))!($DATA(DTOUT))
SET Y=3
+7 KILL DIR,DIRUT,DUOUT,DTOUT
+8 QUIT
+9 ;
XREF(EN,SETKILL) ;CROSS REFERENCE ROUTINE
+1 ;SOMETHING WRONG
IF '$GET(EN)
QUIT
IF '$GET(SETKILL)
QUIT
+2 SET OUTDIEN=$ORDER(^PSDRUG("B","OUTSIDE DRUG",""))
+3 ;Q:OUTDIEN="" ;NO OUTSIDE DRUG!!!
+4 IF 'OUTDIEN
SET LOCAL("DIMSG")="NO DRUG ENTRY 'OUTSIDE DRUG'-ENTER ONE!!"
DO MSG^DIALOG("WM","","","","LOCAL")
SET DIK="^APSQNF("
DO ^DIK
KILL DIK
QUIT
+5 IF SETKILL="ADD"
DO ADD
+6 IF SETKILL="KILL"
DO KILL
+7 QUIT
ADD ;ADD A XREF
+1 ;DRUG FIELD
+2 IF EN=.01
IF $PIECE(^PSNF(DA,0),U,10)
IF $PIECE(^(0),U,12)
Begin DoDot:1
+3 IF X'=OUTDIEN
SET ^PSNF("M",X,$PIECE(^(0),U,10),$PIECE(^(0),U,12))=DA
QUIT
+4 IF $PIECE(^PSNF(DA,0),U,2)
SET ^PSNF("M",X,$PIECE(^(0),U,2),$PIECE(^(0),U,12))=DA
End DoDot:1
+5 QUIT
+6 ;FREE TEXT FIELD
+7 IF EN=1
KILL ;KILL A XREF
+1 IF EN=.01
IF $PIECE(^PSNF(DA,0),U,10)
IF $PIECE(^(0),U,12)
Begin DoDot:1
+2 IF X'=OUTDIEN
KILL ^PSNF("M",X,$PIECE(^(0),U,10),$PIECE(^(0),U,12))
QUIT
+3 IF $PIECE(^PSNF(DA,0),U,2)
KILL ^PSNF("M",X,$PIECE(^(0),U,2),$PIECE(^(0),U,12))
End DoDot:1
+4 QUIT
