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

PSORXI.m

Go to the documentation of this file.
  1. PSORXI ;IHS/DSD/JCM - logs pharmacy interventions ;03/19/93 11:56
  1. ;;7.0;OUTPATIENT PHARMACY;**268,324,251,387,390,417**;DEC 1997;Build 7
  1. ;External reference to ^APSPQA(32.4 supported by DBIA 2179
  1. ; This routine is used to create entries in the APSP INTERVENTION file.
  1. START ;
  1. D INIT,DIC G:PSORXI("QFLG") END
  1. D EDIT
  1. S:'$D(PSONEW("PROVIDER")) PSONEW("PROVIDER")=$P(^APSPQA(32.4,PSORXI("DA"),0),"^",3)
  1. END D EOJ
  1. Q
  1. INIT ;
  1. W !!,"Now creating Pharmacy Intervention",!
  1. I $G(PSODRUG("IEN")) W "for "_$P($G(^PSDRUG(PSODRUG("IEN"),0)),"^"),!
  1. K PSORXI S PSORXI("QFLG")=0
  1. Q
  1. DIC ;
  1. K DIC,DR,DA,X,Y,DD,DO S DIC="^APSPQA(32.4,",DLAYGO=9009032.4,DIC(0)="L",X=DT
  1. S DIC("DR")=".02////"_+PSODFN_";.04////"_DUZ_";.05////"_PSODRUG("IEN")_";.06///PHARMACY"
  1. S DIC("DR")=DIC("DR")_";.07"_$S($G(PSOIVDSN):"////"_$G(PSOIVDSN),$G(PSORX("INTERVENE"))=1:"////18",$G(PSORX("INTERVENE"))=2:"////19",1:"////6")_";.14////0"_";.16////"_$S($G(PSOSITE)]"":PSOSITE,1:"")
  1. D FILE^DICN K DIC,DR,DA
  1. I Y>0 S PSORXI("DA")=+Y S:$G(PSODAL) PSODAL("DA")=+Y
  1. E S PSORXI("QFLG")=1 G DICX
  1. D DIE
  1. DICX K X,Y
  1. Q
  1. DIE ;
  1. K DIE,DIC,DR,DA
  1. S DIE="^APSPQA(32.4,",DA=PSORXI("DA"),DR=$S($G(PSORXI("EDIT"))]"":".03:1600",1:".03;.08")
  1. L +^APSPQA(32.4,PSORXI("DA")):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) D ^DIE K DIE,DIC,DR,X,Y,DA L -^APSPQA(32.4,PSORXI("DA"))
  1. W $C(7),!!,"See 'Pharmacy Intervention Menu' if you want to delete this",!,"intervention or for more options.",!
  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 PSORXI("EDIT")=1 D DIE G EDIT
  1. EDITX W ! K X,Y
  1. Q
  1. DUPINV ;Duplicate and file intervention
  1. N PSOARY,PSOARYC,PSOMSG,PSODA,DUP,DIC,DA,DLAYGO,Y,X
  1. S DUP=^TMP($J,"PSOINTERVENE",+PSODFN),DIC="^APSPQA(32.4,",DIC(0)="AEQM"
  1. D GETS^DIQ(9009032.4,DUP,"**","I","PSOARY","PSOMSG")
  1. I $D(PSOMSG) W !,"Error Retrieving Last Duplicate..." G START
  1. L +^APSPQA(32.4):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
  1. K DIC,DR,DA,X,Y,DD,DO
  1. S DIC="^APSPQA(32.4,",DLAYGO=9009032.4,DIC(0)="",X=DT
  1. D FILE^DICN
  1. L -^APSPQA(32.4)
  1. I Y<1 W !,"Error Encountered Filing Duplicate..." Q
  1. S DA=+Y,PSORXI("DA")=+Y,X=0,^TMP($J,"PSOINTERVENE",PSODFN)=+Y
  1. F S X=$O(PSOARY(9009032.4,DUP_",",X)) Q:'X D
  1. .S PSOARYC(9009032.4,DA_",",X)=PSOARY(9009032.4,DUP_",",X,"I")
  1. S PSOARYC(9009032.4,DA_",",.05)=PSODRUG("IEN")
  1. S PSOARYC(9009032.4,DA_",",.15)=""
  1. D FILE^DIE("K","PSOARYC","PSOMSG") I $D(PSOMSG) D G START
  1. .W !,"Error Encountered Filing Duplicate..."
  1. .N DIK S DA=PSORXI("DA"),DIK="^APSPQA(32.4," D ^DIK
  1. W ! D EN^DIQ,EDIT
  1. Q
  1. EOJ ;
  1. K PSORXI
  1. Q
  1. EN1(PSOX) ; Entry Point if have internal rx #
  1. N PSODFN,PSONEW,PSODRUG,PSOY
  1. I $G(^PSRX(+$G(PSOX),0))']"" W !,$C(7),"No prescription data" G EN1X
  1. S PSORXI("IRXN")=PSOX K PSOY S PSOY=^PSRX(PSORXI("IRXN"),0)
  1. S PSODFN=$P(PSOY,"^",2),PSONEW("PROVIDER")=$P(PSOY,"^",4),PSODRUG("IEN")=$P(PSOY,"^",6)
  1. D START
  1. EN1X ;
  1. Q
  1. ;
  1. EN2(PSOIVDST,PSOX) ; Entry Point for dose interventions with a prescription
  1. ;PSOIVDST = Dosing intervention text
  1. ;PSOX = Internal prescription Number
  1. N PSOIVDSN S PSOIVDSN=0
  1. D LOOK I 'PSOIVDSN Q 1
  1. N PSODFN,PSONEW,PSODRUG,PSOY
  1. I $G(^PSRX(+$G(PSOX),0))']"" W !,$C(7),"No prescription data" G EN2X
  1. S PSORXI("IRXN")=PSOX K PSOY S PSOY=^PSRX(PSORXI("IRXN"),0)
  1. S PSODFN=$P(PSOY,"^",2),PSONEW("PROVIDER")=$P(PSOY,"^",4),PSODRUG("IEN")=$P(PSOY,"^",6)
  1. D START K PSOIVDSN
  1. EN2X Q 0
  1. ;
  1. EN3(PSOIVDST) ; Entry Point for dose interventions without a prescription
  1. ;PSOIVDST = Dosing intervention text
  1. N PSOIVDSN S PSOIVDSN=0
  1. D LOOK I 'PSOIVDSN Q 1
  1. D START K PSOIVDSN
  1. EN3X Q 0
  1. ;
  1. LOOK ;Find Internal Number of 32.3 file
  1. S PSOIVDSN=$$FIND1^DIC(9009032.3,"","X",PSOIVDST,"B")
  1. Q