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

PSOMPHRC.m

Go to the documentation of this file.
  1. PSOMPHRC ;BIRM/JAM - Patient Medication Profile for HRC - Listmanager ;02/01/11
  1. ;;7.0;OUTPATIENT PHARMACY;**382**;DEC 1997;Build 9
  1. ;Reference to ^DISV supported by DBIA 510
  1. ;Standalone option provided to CAPRI supported by DBIA 4595
  1. ;
  1. EN ;Menu option entry point
  1. N PSOEXPDC,PSOEXDCE,PSOSRTBY,PSORDER,PSOSIGDP,PSOSTSGP,PSOSTORD,PSORDCNT,PSOSTSEQ,PSORDSEQ,PSOCHNG
  1. N GRPLN,DIC,Y,DFN,HIGHLN,LASTLINE,VALMCNT,DFN,PSOQIT,WARD,PSODFN,PSOHRC
  1. ;
  1. ; -- Division selection
  1. I '$G(PSOSITE) D ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! G EXIT
  1. S PSOHRC=1
  1. ;
  1. PAT ; -- Patient selection
  1. D EN^PSOPATLK S Y=PSOPTLK
  1. I +Y'>0 G EXIT
  1. S DFN=+Y,PSOQIT=0
  1. D DEM^VADPT I +VADM(6) D G PAT
  1. .W !?10,$C(7),VADM(1)_" ("_VA("PID")_") DIED ON "_$P(VADM(6),"^",2),!
  1. S WARD=$$GET1^DIQ(2,DFN,.1) I WARD]"" D G:PSOQIT PAT
  1. .W !!?10,$C(7),VADM(1)_" ("_VA("PID")_")"
  1. .W !?10,$C(7),"Patient is an Inpatient on Ward "_WARD_" !!"
  1. .W ! D DIR
  1. S PSODFN=DFN D CHKADDR^PSOBAI(DFN,1,1) ;bad address flag/update
  1. ;build listman screen ^TMP("PSOPI",$J, for patient information display
  1. D ^PSOORUT2,^PSOBUILD
  1. D LST(PSOSITE,DFN)
  1. G PAT
  1. Q
  1. ;
  1. LST(SITE,PSODFN) ; -- ListManager entry point
  1. ; Loading Division/User preferences
  1. D LOAD^PSOPMPPF(SITE,DUZ)
  1. W !,"Please wait..."
  1. D EN^VALM("PSO HRC MAIN")
  1. D FULL^VALM1
  1. D EXIT
  1. Q
  1. ;
  1. INIT ; -- rebuild ^TMP("PSOPMP0",$J and PSOLST array from ^TMP("PSOPMP0",$J
  1. N NUM,RX,CNT,TYP
  1. D INIT^PSOPMP0
  1. INT ; rebuild PSOLST only
  1. K PSOLST
  1. S (NUM,CNT)=0
  1. F S NUM=$O(^TMP("PSOPMP0",$J,NUM)) Q:'NUM D
  1. .F TYP="RX","PEN","NVA" S RX=$G(^TMP("PSOPMP0",$J,NUM,TYP)) I RX'="" D
  1. ..S CNT=CNT+1,PSOLST(CNT)=$S(TYP="RX":52,TYP="PEN":52.41,1:55.05)_"^"_RX_"^"_$P($$STSINFO^PSOPMP1(RX),"^",2)
  1. S PSOCNT=CNT
  1. Q
  1. ;
  1. HDR ; -- header code
  1. S VALMHDR(1)="This is a test header for PSO HRC REFILL SELECTION."
  1. S VALMHDR(2)="This is the second line"
  1. Q
  1. ;
  1. HDRF ; -- rebuild listman array for Speed refill
  1. I $G(PSOHRCF) D INIT^PSOPMP0
  1. K PSOHRCF
  1. Q
  1. ;
  1. SEL ; -- Process selection of RX entries
  1. N PSOSEL,PSOLIS,TYPE,XQORM,ORD,TITLE,XX
  1. S PSOLIS=$P(XQORNOD(0),"=",2) I 'PSOLIS S VALMSG="Invalid selection!",VALMBCK="R" Q
  1. S TITLE=VALM("TITLE")
  1. F XX=1:1:$L(PSOLIS,",") Q:$P(PSOLIS,",",XX)']"" D
  1. .S PSOSEL=+$P(PSOLIS,",",XX) I 'PSOSEL S VALMSG="Invalid selection!" Q
  1. .S TYPE=$O(^TMP("PSOPMP0",$J,PSOSEL,0)) I TYPE="" S VALMSG="Invalid selection!" Q
  1. .S ORD=$G(^TMP("PSOPMP0",$J,PSOSEL,TYPE))
  1. .I 'ORD S VALMSG="Invalid selection!" Q
  1. .D INT
  1. .;
  1. .; -- Regular prescription
  1. .I TYPE="RX" D S VALMBCK="R" D REF^PSOPMP0
  1. .. N STAT,PROACT,LINE,TITLE
  1. .. S (Y,ORN)=PSOSEL,COPY=1
  1. .. D NEWSEL^PSOORNE2,INIT
  1. .. S STAT=$$GET1^DIQ(52,$P(PSOLST(ORN),"^",2),100,"I"),PSOACT=$S('STAT:"R",1:""),VALMSG="Enter ?? for more actions"
  1. .. D LG
  1. .;
  1. .; -- Pending Order
  1. .I TYPE="PEN" D S VALMBCK="R" D REF^PSOPMP0
  1. .. N PSOACTOV,OR0,OLVLM,LINE,TITLE
  1. .. S OR0=^PS(52.41,ORD,0),PSOACTOV=1,OLVLM=$$ADPL()
  1. .. D PENHDR^PSOPMP1(PSODFN),DSPL^PSOORFI1
  1. .. I OLVLM S ^DISV(+$G(DUZ),"VALMMENU",$P(OLVLM,"^",2))=OLVLM
  1. .;
  1. .; -- Non-VA Order
  1. .I TYPE="NVA" D
  1. .. N LINE,TITLE D EN^PSONVAVW(PSODFN,ORD)
  1. .;
  1. S VALMBCK="R",VALM("TITLE")=TITLE
  1. Q
  1. ;
  1. ACTIONS() ; -- screen actions on active orders
  1. N DIC,X,Y
  1. K DIC,Y S DIC="^ORD(101,"_DA(1)_",10,",X=DA,DIC(0)="ZN" D ^DIC Q:Y<0 0
  1. S Y=Y(0,0)
  1. I Y="PSO REFILL" Q $S(PSOACT["R":1,1:0)
  1. Q 1
  1. ;
  1. ADPL() ; -- disable actions for pending orders
  1. N DIC,X,Y,OLVAL,PRCT
  1. S DIC="^ORD(101,",X="PSO PENDING ORDER MENU",DIC(0)="ZN" D ^DIC Q:Y<0 ""
  1. S PRCT=+Y_";ORD(101,",OLVAL=$G(^DISV(+$G(DUZ),"VALMMENU",PRCT)) I OLVAL="" Q ""
  1. I 'OLVAL Q 0_"^"_PRCT
  1. S ^DISV(+$G(DUZ),"VALMMENU",PRCT)=0
  1. Q 1_"^"_PRCT
  1. ;
  1. PI ; -- entry point for PSO HRC Patient Information
  1. I '$D(^TMP("PSOPI",$J)) D ^PSOORUT2
  1. D EN^VALM("PSO HRC Patient Information")
  1. S VALMBCK="R"
  1. Q
  1. DD ; -- entry point for PSO HRC DETAILED ALLERGY
  1. D EN^VALM("PSO HRC DETAILED ALLERGY")
  1. Q
  1. ;
  1. LG ; -- entry point for PSO HRC REFILL
  1. S (VALMCNT,PSOPF)=$O(^TMP("PSOAO",$J,"A"),-1)
  1. D EN^VALM("PSO HRC REFILL")
  1. Q
  1. DIR ; -- Dir call
  1. N DIR,X,Y
  1. S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do You Want To Continue" D ^DIR K DIR
  1. S:'Y PSOQIT=1
  1. K DIRUT,DTOUT,DUOUT
  1. Q
  1. EXIT ;
  1. K ^TMP("PSOPMP0",$J),^TMP("PSOPMPSR",$J),^TMP("PSODA",$J),^TMP("PSONVAVW",$J)
  1. K COPY,DA,PSOCNT,PSONEW,ORN,PSOACT,PSOPF,PSOHRCF
  1. D KVA^VADPT,PTX^PSORX1,EOJ^PSORX1
  1. Q
  1. ;
  1. HELP Q