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

PSOMLLD2.m

Go to the documentation of this file.
  1. PSOMLLD2 ;BIR/LE - Service Connection Check for SC>50% ;02/27/04
  1. ;;7.0;OUTPATIENT PHARMACY;**143,219,239,225,431,514,547**;DEC 1997;Build 1
  1. ;External reference SDC022 supported by DBIA 1579
  1. ;External reference DIS^SDROUT2 private by DBIA 112
  1. ;External reference $$GETSHAD^DGUTL3 supported by DBIA 4462
  1. ;External reference ^DPT(DFN,.372 private by DBIA 1476
  1. ;External reference ^DIC(31 supported by DBIA 658
  1. SC ;This routine is used for SC>50% - OUTSIDE OF COPAY - DFN AND PSOSCP VARIABLES ARE EXPECTED TO BE PRESENT WHEN CALLED
  1. ; Requires: DFN, PSOSCP, PSOSCA
  1. I '$G(DFN) N DFN S DFN=+$G(PSODFN)
  1. ;I $G(DFN) I '$$SC^SDCO22(DFN) D Q ;if SC>49 don't ask if api says not to
  1. ;. K PSOANSQ("SC>50"),PSOANSQD("SC>50") I $G(PSOX("IRXN")) K PSOANSQ(PSOX("IRXN"),"SC>50")
  1. SC2 I $G(PSOMESOI)=1,$G(PSORXED) W !!,"The Pharmacy Orderable Item has changed for this order. Please review any",!,"existing SC or Environmental Indicator defaults carefully for appropriateness.",! S PSOMESOI=2
  1. I $G(PSOMESFI)=1 W !!,"The Pharmacy Orderable Item has changed for this order. Please review any",!,"existing SC or Environmental Indicator defaults carefully for appropriateness.",! S PSOMESFI=2
  1. N PSODISAR D CHKPAG,DISSCD ;*514
  1. N PSOUFLAG S PSOUFLAG=0 K DIR S DIR(0)="Y"
  1. S DIR("A")="Was treatment for a Service Connected condition"
  1. S DIR("?")=" ",DIR("?",1)="Enter 'Yes' if this prescription is being used to treat a condition related",DIR("?",2)="to Service Connected."
  1. I '$G(PSOFLAG) D
  1. . I PSOSCP<50 S (DIR("B"),PSOUFLAG)=$S($G(PSORX(+$G(PSORENW("OIRXN")),"SC"))=0:"NO",$G(PSORX(+$G(PSORENW("OIRXN")),"SC"))=1:"YES",1:"") I DIR("B")="" K DIR("B") S PSOUFLAG=0
  1. . I PSOSCP<50&($D(PSORX(+$G(PSORENW("OIRXN")),"SC>50"))) S (DIR("B"),PSOUFLAG)=$S($G(PSORX(+$G(PSORENW("OIRXN")),"SC>50"))=0:"NO",$G(PSORX(+$G(PSORENW("OIRXN")),"SC>50"))=1:"YES",1:"") I DIR("B")="" K DIR("B") S PSOUFLAG=0
  1. . I PSOSCP>49 S (DIR("B"),PSOUFLAG)=$S($G(PSORX(+$G(PSORENW("OIRXN")),"SC>50"))=0:"NO",$G(PSORX(+$G(PSORENW("OIRXN")),"SC>50"))=1:"YES",1:"") I DIR("B")="" K DIR("B") S PSOUFLAG=0
  1. . I '$D(DIR("B"))&($D(PSOANSQD("SC>50"))!($D(PSOANSQD("SC")))) D I '$D(DIR("B")) K DIR("B") S PSOUFLAG=0
  1. .. I $D(PSOANSQD("SC>50")) I $G(PSOANSQD("SC>50"))=0!($G(PSOANSQD("SC>50"))=1) S (PSOUFLAG,DIR("B"))=$S($G(PSOANSQD("SC>50"))=1:"YES",1:"NO")
  1. .. I $D(PSOANSQD("SC")) I $G(PSOANSQD("SC"))=0!($G(PSOANSQD("SC"))=1) S (PSOUFLAG,DIR("B"))=$S($G(PSOANSQD("SC"))=1:"YES",1:"NO")
  1. I $G(PSORX("SC"))]""!($G(PSORX(+$G(PSORENW("OIRXN")),"SC"))'="") S DIR("B")=$S($G(PSORX("SC"))="SC":"YES",$G(PSORX("SC"))="NSC":"NO",$G(PSORX(+$G(PSORENW("OIRXN")),"SC"))=1:"YES",$G(PSORX(+$G(PSORENW("OIRXN")),"SC"))=0:"NO",1:"")
  1. ;
  1. I $G(PSOFLAG),$G(PSONEWFF) I $G(PSOANSQD("SC>50"))=0!($G(PSOANSQD("SC>50"))=1) S DIR("B")=$S($G(PSOANSQD("SC>50"))=1:"YES",1:"NO")
  1. I $G(DIR("B"))="YES"!($G(DIR("B"))="NO") S PSOUFLAG=$G(DIR("B"))
  1. I $G(DIR("B"))="" K DIR("B")
  1. W ! D ^DIR K DIR
  1. I $G(Y)=1!($G(Y)=0) D I $G(PSONEWFF),$G(PSOFLAG) S PSOANSQD("SC>50")=$G(Y)
  1. . I $G(PSOX("IRXN")) S PSOANSQ(PSOX("IRXN"),"SC>50")=+Y
  1. . S PSOANSQ("SC>50")=+Y
  1. I PSOFLAG I Y["^"!($D(DTOUT))!($D(DUOUT)) S PSOCPZ("DFLG")=1
  1. S:Y=0 Y=2
  1. S PSOANSR=+Y I 'PSOANSR,'PSOFLAG D S $P(PSOCPAY,"^")=$S($G(PSOUFLAG)="NO":1,1:0) W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR Q
  1. .W !!,"This Renewal has been designated as "_$S($G(PSOUFLAG)="YES":"SERVICE CONNECTED",1:"NON-SERVICE CONNECTED.")
  1. .;W !,"Please use the 'Reset Copay Status/Cancel Charges' option to make corrections."
  1. .S PSOANSQ("SC>50")=$S($G(PSOUFLAG)="YES":1,1:0)
  1. I $G(PSOFLAG),$G(PSOCPZ("DFLG")) G EXIT
  1. S:PSOANSR=1 PSOCPAY=0 S:PSOANSR=2 $P(PSOCPAY,"^")=1
  1. EXIT ;
  1. K PSOANSR,DIR,DUOUT,DIRUT,DTOUT,Y,X,PSOSCA
  1. Q
  1. ;
  1. PAUSE K DIR W ! S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
  1. Q
  1. ;
  1. SHAD ; PROJ 112/SHAD Question
  1. I $G(PSODFN),$L($T(GETSHAD^DGUTL3)) I $$GETSHAD^DGUTL3(PSODFN)'=1 D Q
  1. . K PSOANSQ("SHAD"),PSOANSQD("SHAD") I $G(PSOX("IRXN")) K PSOANSQ(PSOX("IRXN"),"SHAD")
  1. N PSOUFLAG S PSOUFLAG=0
  1. K DIR S DIR(0)="Y"
  1. S DIR("A")="Was treatment related to PROJ 112/SHAD"
  1. S DIR("?")=" "
  1. S DIR("?",1)="Enter 'Yes' if this prescription is being used to treat a condition due to"
  1. S DIR("?",2)="Shipboard Hazard and Defense (SHAD) exposure."
  1. S DIR("?",3)="This response will be used to determine whether or not a copay should"
  1. S DIR("?",4)="be applied to the prescription."
  1. I '$G(PSOFLAG) D
  1. . S (DIR("B"),PSOUFLAG)=$S($G(PSORX(+$G(PSORENW("OIRXN")),"SHAD"))=0:"NO",$G(PSORX(+$G(PSORENW("OIRXN")),"SHAD"))=1:"YES",1:"")
  1. . I DIR("B")="" K DIR("B") S PSOUFLAG=0
  1. I $G(PSOFLAG),$G(PSONEWFF) D
  1. . I $G(PSOANSQD("SHAD"))=0!($G(PSOANSQD("SHAD"))=1) D
  1. . . S DIR("B")=$S($G(PSOANSQD("SHAD"))=1:"YES",1:"NO")
  1. W ! D ^DIR K DIR
  1. I $G(PSOFLAG) W ! D Q
  1. . I Y["^"!($D(DUOUT))!($G(DTOUT)) S PSOCPZ("DFLG")=1 Q
  1. . S PSOANSQ("SHAD")=Y
  1. . I $G(PSONEWFF) S PSOANSQD("SHAD")=Y
  1. I Y["^"!($D(DUOUT))!($D(DTOUT)) D Q
  1. . W !!,"This Renewal has been designated as"_$S($G(PSOUFLAG)="YES":"",1:" NOT")_" being used for treatment of "
  1. . W !,"Shipboard Hazard and Defense (SHAD) exposure." D:$G(PSOSCP)<50 MESS^PSOMLLDT D PAUSE
  1. . S PSOANSQ(PSOX("IRXN"),"SHAD")=$S($G(PSOUFLAG)="YES":1,1:0)
  1. I $G(PSOX("IRXN")) S PSOANSQ(PSOX("IRXN"),"SHAD")=Y
  1. E S PSOANSQ("SHAD")=Y
  1. Q
  1. ;
  1. CHKPAG ;
  1. N PSOSPACE K PSODISAR S $P(PSOSPACE," ",50)=""
  1. S I3=0 F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:'I D
  1. .S I1=^DPT(DFN,.372,I,0) I $P(I1,"^",3) D
  1. ..S I2=$S($D(^DIC(31,+I1,0)):^(0),1:""),I2=$S($P(I2,"^",4)]"":$P(I2,"^",4),1:$P(I2,"^"))
  1. ..S PSODISAR(I)=I2_$E(PSOSPACE,1,48-$L(I2))_$J($P(I1,"^",2),4)_"% - "_$S($P(I1,"^",3):"SERVICE CONNECTED",1:""),I3=I3+1
  1. I 'I3 S PSODISAR(1)=$S('$O(^DPT(DFN,.372,0)):"NONE STATED",1:"NO SC DISABILITIES LISTED")
  1. S PSODISAR=I3
  1. K I1,I2,I3
  1. Q
  1. ;
  1. DISSCD ;DISPLAY SERVICE CONNECTED DISABILITIES - REPLACES CALL TO DIS^SDROUT2
  1. ;
  1. ;rated disabilities
  1. ; -- Pharmacy is allowed to call this tag via a special agreement
  1. ; with MAS. MAS should notify pharmacy developers of any
  1. ; changes that may impact PS* code. (5/91 - MJK/BOK)
  1. ;
  1. I '$D(VAEL) D ELIG^VADPT S DGKVAR=1
  1. I $Y<3,$O(PSODISAR(0)) W "DRUG: "_$S($G(PSODRUG("TRADE NAME"))]"":PSODRUG("TRADE NAME"),1:$G(PSODRUG("NAME")))
  1. W:'+VAEL(3) !!,"Service Connected: NO" W:+VAEL(3) !!," SC Percent: ",$P(VAEL(3),"^",2)_"%"
  1. W !," Disabilities: " I 'VAEL(4),$S('$D(^DG(391,+VAEL(6),0)):1,$P(^(0),"^",2):0,1:1) W "NOT A VETERAN" G DISQ
  1. S I=0 F S I=$O(PSODISAR(I)) Q:'I D
  1. .W !,PSODISAR(I)
  1. .I $Y+3>IOSL D
  1. ..S DIR(0)="E",DIR("A")=" Press the return key to continue" D ^DIR W @IOF
  1. ..I $O(PSODISAR(I)) W "DRUG: "_$S($G(PSODRUG("TRADE NAME"))]"":PSODRUG("TRADE NAME"),1:$G(PSODRUG("NAME"))),!
  1. DISQ I $D(DGKVAR) D KVAR^VADPT K DGKVAR,I
  1. Q