- 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
