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

PSJRXI.m

Go to the documentation of this file.
  1. PSJRXI ; IHS/DSD,JCM,RLW - LOGS PHARMACY INTERVENTIONS ;15 May 98 9:28 AM
  1. ;;5.0;INPATIENT MEDICATIONS;**3,181,254,267,275,281**;16 DEC 97;Build 113
  1. ;
  1. ;Reference to ^APSPQA(32.4 is supported by DBIA #2179
  1. ;Reference to ^PSDRUG( supported by DBIA #2192
  1. ;Reference to ^DD("DILOCKTM" supported by DBIA #999
  1. ;
  1. ; This routine is used to create entries in the APSP INTERVENTION file.
  1. ;---------------------------------------------------------------
  1. START ;
  1. N SAVEX,SAVEY S SAVEX=X,SAVEY=Y
  1. D INIT
  1. D DIC G:PSJRXI("QFLG") END
  1. D EDIT
  1. S:'$D(PSJNEW("PROVIDER")) PSJNEW("PROVIDER")=$P(^APSPQA(32.4,PSJRXI("DA"),0),"^",3)
  1. END D EOJ
  1. Q
  1. ;---------------------------------------------------------------
  1. INIT ;
  1. W !!,"Now creating Pharmacy Intervention",!
  1. I $G(PSJDD) W "For ",$P($G(^PSDRUG(PSJDD,0)),"^"),!
  1. K PSJRXI
  1. S PSJRXI("QFLG")=0
  1. Q
  1. ;
  1. DIC ;
  1. N DIC,DR,DA,X,DD,DO,Y,PSJY,PSJRXIEN
  1. I $G(PSJRXREQ)="" S PSJRXREQ="ALLERGY"
  1. D FIND^DIC(9009032.3,"","@;.01","",PSJRXREQ,1,"B","","","PSJRXIEN")
  1. S PSJRXIEN=$G(PSJRXIEN("DILIST",2,1))
  1. I 'PSJRXIEN S PSJY=-1 G DICX
  1. S DIC="^APSPQA(32.4,",DLAYGO=9009032.4,DIC(0)="L",X=DT
  1. S DIC("DR")=".02////"_PSGP_";.04////"_DUZ_";.05////"_PSJDD_";.06///PHARMACY"
  1. S DIC("DR")=DIC("DR")_";.07////"_$G(PSJRXIEN)_";.14////1"_";.16////"_$S($G(PSJSITE)]"":PSJSITE,1:"")
  1. D FILE^DICN K DIC,DR,DA
  1. S PSJY=Y
  1. I Y>0 S PSJRXI("DA")=+Y
  1. E S PSJRXI("QFLG")=1 G DICX
  1. D DIE
  1. DICX ;
  1. I $G(PSJY)=-1 D
  1. . W !!,"Unable to log an intervention for ",$G(PSJRXREQ)
  1. . D PAUSE^PSJLMUT1
  1. K X,Y
  1. Q
  1. DIE ;
  1. K DIE,DIC,DR,DA N PSJRECOM,PSJOVRS,PSJINTOI,PSJTMPDT
  1. S DIE="^APSPQA(32.4,",DA=PSJRXI("DA"),DR=$S($G(PSJRXI("EDIT"))]"":".03:1600",$G(PSJAADPT):".03;",1:".03;.08")
  1. L +^APSPQA(32.4,PSJRXI("DA")):$S($G(^DD("DILOCKTM")):+$G(^DD("DILOCKTM")),1:3) E W !,"Sorry, someone else is editing this intervention!" Q
  1. D ^DIE K DIE,DIC,DR,X,Y,DA
  1. I $G(PSJAADPT) N PSJQREC S PSJQREC=0 F Q:$G(PSJQREC) D
  1. .K DIC S PSJQREC="" S DIC="9009032.5",DIC(0)="EZ",X="UNABLE TO ASSESS" D ^DIC S:$G(Y)>0 PSJQREC=+Y I '($G(Y)>0) S DIC="9009032.5",DIC(0)="EZ",X="OTHER" D ^DIC S:$G(Y)>0 PSJQREC=+Y
  1. .N DIR S DIR(0)="S^1:UNABLE TO ASSESS;2:OTHER",DIR("A")="RECOMMENDATION",DIR("?",1)=" Enter a recommendation for NO ALLERGY ASSESSMENT.",DIR("?")=" Enter 'OTHER' to add free text."
  1. .D ^DIR S PSJQREC=$S(PSJQREC>0:+PSJQREC,1:0) I PSJQREC D
  1. ..S DIE="^APSPQA(32.4,",DA=PSJRXI("DA"),DR=".08////"_PSJQREC D ^DIE
  1. .I $G(Y)="^" S PSJQREC=-1
  1. .K DIE,DIC,DR,X,Y,DA
  1. I $G(PSJDD) S PSJINTOI=+$G(^PSDRUG(+PSJDD,2))
  1. S PSJTMPDT=+$G(^TMP("PSJINTER",$J,+$G(PSJRXI("DA"))-1))
  1. I $G(PSGDT) I $G(PSJRXREQ)="ALLERGY"!($G(PSJRXREQ)["CRITICAL DRUG") S ^TMP("PSJINTER",$J,PSJRXI("DA"))=$S($G(PSJTMPDT):PSJTMPDT,1:$G(PSGDT))_"^"_$S($G(PSJINTOI):PSJINTOI,1:"")_"^"_$$DATE2^PSJUTL2($$DATE^PSJUTL2())
  1. S PSJRECOM=$P($G(^APSPQA(32.4,PSJRXI("DA"),0)),"^",8) D
  1. .S PSJOVRS="",X=PSJRECOM,Y="",DIC="^APSPQA(32.5,",DIC(0)="BSX" D ^DIC I $P(Y,"^",2)]"" S PSJOVRS=$P(Y,"^",2)
  1. .I PSJRECOM=9 D
  1. ..S DIE="^APSPQA(32.4,",DA=PSJRXI("DA"),DR="1200;" D ^DIE K DIE,DIC,DR,X,Y,DA
  1. L -^APSPQA(32.4,PSJRXI("DA"))
  1. W $C(7),!!,"See 'Pharmacy Intervention Menu' if you want to delete this",!,"intervention or for more options.",! D PAUSE^PSJLMUT1
  1. Q
  1. EDIT ;
  1. K DIR W ! S DIR(0)="Y",DIR("A")="Would you like to edit this intervention",DIR("B")="N" D ^DIR K DIR I $D(DIRUT)!'Y G EDITX
  1. S PSJRXI("EDIT")=1 D DIE
  1. G EDIT
  1. EDITX K X,Y
  1. Q
  1. ;
  1. EOJ ;
  1. I $G(PSJDAL) S PSJDAL("DA")=$G(PSJRXI("DA"))
  1. K PSJRXI S X=SAVEX,Y=SAVEY
  1. Q
  1. ;
  1. EN1(PSJORDER) ; Entry Point if have internal rx #
  1. I PSJX']"" W !,$C(7),"No prescription data" Q
  1. S PSJORDER=$S((PSJORDER["N")!(PSJORDER["P"):"^PS(53.1,"_+PSJORDER,PSJORDER["V":"^PS(55,"_DFN_",""IV"","_+PSJORDER,1:"^PS(55,"_DFN_",5,"_+PSJORDER)_","
  1. N PSJDFN,PSJNEW,PSJDRUG,PSJY
  1. I $G(^PS(53.1,PSJX,0))']"" W !,$C(7),"No prescription data" G EN1X
  1. S PSJRXI("IRXN")=PSJORDER
  1. K PSJY S PSJY=@(PSJORDER_",0)")
  1. S PSJDFN=$P(PSJY,"^",15),PSJNEW("PROVIDER")=$P(PSJY,"^",2)
  1. S PSJDRUG=0,PSJDRUG=$O(^PS(53.1,PSJRXI("IRXN"),1,PSJDRUG)) Q:'PSJDRUG S PSJDRUG("IEN")=$G(@(PSJORDER_","_PSJDRUG),"^")
  1. D START
  1. EN1X Q
  1. ;
  1. EN3(PSJIVDST,CDRG2) ; Entry Point for Clinical Reminders
  1. ;PSJIVDST = intervention text
  1. N PSJIVDSN S PSJIVDSN=0
  1. ;D LOOK I 'PSJIVDSN Q 1
  1. S PSJRXREQ=PSJIVDST
  1. S PSJDD=CDRG2
  1. D START K PSJIVDSN,CDRG2
  1. EN3X Q 0
  1. ;
  1. LOOK ;Find Internal Number of 32.3 file
  1. S PSJRXIEN=$$FIND1^DIC(9009032.3,"","X",PSJIVDST,"B")
  1. Q