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

PSODEMSB.m

Go to the documentation of this file.
  1. PSODEMSB ;EPIP/RTW - PSODEM subroutines ; 7/29/17 3:24pm
  1. ;;7.0;OUTPATIENT PHARMACY;**452,564,570,607,664**;Dec 1997;Build 6
  1. ;------------------------------------------------------------------
  1. ; External reference to $$OUTPTTM^SDUTL3 supported by ICR 1252
  1. ; External reference to ^DIE supported by ICR 2022
  1. ; External references to $$GET1^DIQ supported by ICR 2056
  1. ; External reference to ^PS(55 supported by ICR 2228
  1. ; External reference to $$GETALL^SCAPMCA supported by ICR 2848
  1. ; External reference to VST^ORWCV supported by ICR 4211
  1. ; External reference to $$SDAPI^SDMACA301 supported by ICR 4433
  1. ; External reference to ^DD("DILOCKTM" supported by ICR 4909
  1. ; External reference to ^DIC supported by ICR 10006
  1. ; External reference to ^DIR supported by ICR 10026
  1. ; External reference to ^DPT( supported by ICR 10035
  1. ; External reference to ^VA(200 supported by ICR 10060
  1. ; External reference to LOCK^DILF($NA( supported by ICR 2054
  1. ;------------------------------------------------------------------
  1. DEMOG(PSODFN) ;
  1. ; Extend patient demographics with PC Team, Current Facility
  1. ; Remarks, and Clinical Alerts, pause the screen until <Enter>
  1. ; Input:
  1. ; DFN ; Required ; IEN of Patient file (#2) entry
  1. ;
  1. Q:$D(XQORNOD(0))
  1. N PSOTEAM,PSOCLINA,DIR,DIRUT,PG,X,Y
  1. I $G(XQY0)["PSO P",(IO=IO(0)),$E(IOST)="C" D ; PSO*7*607
  1. . W !
  1. . S DIR("T")=DTIME,DIR(0)="EA",DIR("A")="Press <Enter> to continue: " D ^DIR
  1. ;
  1. S PG=0
  1. D PCTEAM(PSODFN)
  1. I 'PSOTEAM W !! D HDR("Extended Patient Demographics:")
  1. D REMARKS(PSODFN)
  1. W !?1,"Assigned/Recent Facility: ",$$CURRFAC(PSODFN)
  1. D CA(PSODFN)
  1. Q:$D(DIRUT)
  1. I $G(XQY0)'["OR CPRS GUI CHART",(IO=IO(0)),$E(IOST)="C" D ;
  1. . W !
  1. . S DIR("T")=DTIME,DIR(0)="EA",DIR("A")="Press <Enter> to continue: " D ^DIR
  1. Q
  1. ;------------------------------------------------------------------
  1. CA(PSODFN) ; Print PHARMACY PATIENT CLINICAL ALERTS multiple field (#2)
  1. ; Input:
  1. ; DFN ; Required ; IEN of Patient file (#2) entry
  1. ;
  1. N PSOFLAG1,PSODATER
  1. ;
  1. Q:'$G(PSODFN) ; Quit, if no Patient IEN
  1. Q:'$P($G(^PS(55,PSODFN,2,0)),U,4) ; No CLINICAL ALERTS
  1. ;
  1. S PSOFLAG1=1,PSOCLINA=0 ; First time flag to display field header
  1. ;
  1. ; PSODATER format DINUMed: 9999999.999999-CLINICAL ALERT DATE/TIME
  1. S PSODATER=0
  1. F S PSODATER=$O(^PS(55,PSODFN,2,PSODATER)) Q:'PSODATER D Q:$D(DIRUT) ;
  1. . I PSOFLAG1=1 W !!,"Clinical Alerts:" S PSOFLAG1=0
  1. . ; Display CLINICAL ALERT DATE/TIME (#.01) & CLINICAL ALERT (#1)
  1. . W !!,?2,$$GET1^DIQ(55.0109,PSODATER_","_PSODFN,.01)
  1. . W " ",$$GET1^DIQ(55.0109,PSODATER_","_PSODFN,1)
  1. . I '$G(PAGE)!($Y+7>IOSL),$O(^PS(55,PSODFN,2,PSODATER)) D HDR("Clinical Alerts:")
  1. Q
  1. ;------------------------------------------------------------------
  1. HDR(HDR) ;
  1. N DIR
  1. I '$D(OPT) S OPT=$G(XQY0) ;p664 OPT=Option
  1. W !
  1. ;PSO*7*607
  1. I PG,IO=IO(0),$E(IOST)="C" S DIR("T")=DTIME,DIR(0)="EA",DIR("A")="Type <Enter> to continue or '^' to exit Clinical Alerts:" D ^DIR I $D(DIRUT) Q
  1. I $G(XQY0)["PSO LMOE FINISH"!($G(XQY0)["PSO VIEW") D ;P664
  1. . I $G(OPT)'=$G(XQY0) S PAGE=0 S OPT=$G(XQY0)
  1. I HDR]"" W @IOF S PAGE=$G(PAGE)+1 W HDR,?70,"Page: ",PAGE,! S $Y=1
  1. Q
  1. CURRFAC(PSODFN) ; Return: The Assigned/Recent Facility INSTITUTION for the Patient's DFN
  1. ; Input:
  1. ; DFN ; Required ; IEN of Patient file (#2) entry
  1. ;
  1. N DATA,DTBEG,DTEND,FLAGQ,IEN4,ORVISIT,PCTEAM,PREVSCDT,RETURN,SUB
  1. ;
  1. S RETURN="" ; Default return value is null
  1. ;
  1. I $$GET1^DIQ(2,PSODFN,.351,"I") Q RETURN ; .351 Patient DATE OF DEATH
  1. ;
  1. ; The first choice for returning the INSTITUTION would be the
  1. ; INSTITUTION field (#.07) of the TEAM file (#404.51)
  1. ;
  1. S PCTEAM=$$OUTPTTM^SDUTL3(PSODFN,DT,1) ; IEN^NAME of file (#404.51) ; ICR #1252
  1. ; *** End patch #1 change #1 by R2/Confer on 08/07/2015
  1. I +PCTEAM>0 D Q RETURN
  1. . S RETURN=$$GET1^DIQ(404.51,+PCTEAM,.07) ; INSTITUTION [R*P4']
  1. ;
  1. ; Return future appointments and past visits for a patient
  1. ;
  1. S DTBEG=DT-20000 ; Begin with TODAY - 2 years
  1. S DTEND=DT+20000 ; End with TODAY + 2 years
  1. D VST^ORWCV(.ORVISIT,PSODFN,DTBEG,DTEND) ; ICR #4211
  1. ;
  1. ; Process ORVISIT array in reverse chronological order. Quantify
  1. ; visits & appointments based upon the INSTITUTION pointer field (#3)
  1. ; of the HOSPITAL LOCATION file (#44). Once the count reaches
  1. ; 3 for a given INSTITUTION, that INSTITUION is returned.
  1. ;
  1. S FLAGQ=0 ; Quit flag, set to 1 once the Institution is determined
  1. S PREVSCDT="" ; Previous appt/visit date
  1. S SUB=":" ;.... Sequential number of ORVISIT array subscript
  1. F S SUB=$O(ORVISIT(SUB),-1) Q:'SUB!FLAGQ D ;
  1. . N DATA,SC,SCDT
  1. . S DATA=ORVISIT(SUB)
  1. . S SC=$P($P(DATA,U),";",3) Q:'SC ; HOSPITAL LOCATION file (#44) IEN
  1. . S IEN4=+$$GET1^DIQ(44,SC,3,"I") ; INSTITUTION file (#4) IEN
  1. . S SCDT=$P($P(DATA,U),";",2) Q:'SCDT ; Appt/visit date (fm format)
  1. . S SCDT=$P(SCDT,".") ; Strip the time
  1. . Q:SCDT=PREVSCDT ; Appt/visit must be a N day
  1. . I '$D(IEN4(IEN4)) S IEN4(IEN4)=0 ; Initialize INSTITUTION counter
  1. . S IEN4(IEN4)=IEN4(IEN4)+1 ; Quantify by INSTITUTION ien
  1. . I IEN4(IEN4)=3 D Q ; When count reaches 3, INSTITUTION found
  1. . . S RETURN=$$GET1^DIQ(4,IEN4,.01) ; INSTITUTION NAME (#.01)
  1. . . S FLAGQ=1
  1. . ;
  1. . S PREVSCDT=SCDT ; Save as previous appt/visit date
  1. ;
  1. ; IF no PCTEAM INSTITUTION
  1. ; AND three appt/visits were not found for an INSTITUTION ien
  1. ; AND at least one appt/visit was found
  1. ; THEN
  1. ; return the most recent appt/visit INSTITUTION
  1. ;
  1. I RETURN="" D ;
  1. . N DATA,IEN4,SC,SUB
  1. . S SUB=$O(ORVISIT(":"),-1) Q:'SUB
  1. . S DATA=ORVISIT(SUB)
  1. . S SC=$P($P(DATA,U),";",3) Q:'SC ; HOSPITAL LOCATION file (#44) IEN
  1. . S IEN4=$$GET1^DIQ(44,SC,3,"I") ; INSTITUTION file (#4) IEN
  1. . S RETURN=$$GET1^DIQ(4,IEN4,.01) ; INSTITUTION file (#4) NAME (#.01)
  1. ;
  1. Q RETURN
  1. ;------------------------------------------------------------------
  1. PCTEAM(PSODFN) ; Display current PC TEAM, PC Provider, and phone.
  1. ; Input:
  1. ; DFN ; Required ; IEN of Patient file (#2) entry
  1. ;
  1. S PSOTEAM=0
  1. N DATA,PAGER,PCPOS,PCPROV,PCPROVI,PHONE,PCTM
  1. N SCDT2,SCP,SDI,TEAM,TEAMI
  1. ;
  1. S PCTM="^TMP(""SDPLIST"",$J)"
  1. K @PCTM
  1. S SDI=$$GETALL^SCAPMCA(PSODFN,DT,PCTM) Q:'SDI ; ICR #2848
  1. S SDI=0
  1. F S SDI=$O(^TMP("SDPLIST",$J,PSODFN,"PCTM",SDI)) Q:'SDI D ;
  1. . ;
  1. . ; "PCTM" node (PC Team)
  1. . S PSOTEAM=1
  1. . S DATA=$G(^TMP("SDPLIST",$J,PSODFN,"PCTM",SDI)) Q:DATA=""
  1. . S TEAMI=$P(DATA,U,1) ; IEN of TEAM file (#404.51)
  1. . S TEAM=$P(DATA,U,2) ;. NAME of TEAM file entry
  1. . ;
  1. . ; "PCPR" node (PC Provider)
  1. . S DATA=$G(^TMP("SDPLIST",$J,PSODFN,"PCPR",SDI))
  1. . S PCPROVI=+$P(DATA,U,1) ; IEN of PC Provider
  1. . S PCPROV=$P(DATA,U,2) ;. PC Provider
  1. . S PCPOS=$P(DATA,U,4) ;.. PC Provider Position
  1. . S PAGER=$$GET1^DIQ(200,PCPROVI,.138) ; DIGITAL PAGER
  1. . S:PAGER="" PAGER=$$GET1^DIQ(200,PCPROVI,.137) ; VOICE PAGER
  1. . S PHONE=$$GET1^DIQ(200,PCPROVI,.132) ; OFFICE PHONE
  1. . ;
  1. . I PSOTEAM W !! D HDR("Extended Patient Demographics:")
  1. . ;
  1. . W !," Primary Care Team: ",TEAM
  1. . W ?52," Phone: ",$$GET1^DIQ(404.51,TEAMI,.02) ; TEAM PHONE NUMBER
  1. . ;
  1. . W !," PC Provider: ",PCPROV
  1. . W ?52,"Position: ",$E(PCPOS,1,18)
  1. . ;
  1. . W !?13,"Pager: ",PAGER
  1. . W ?52," Phone: ",PHONE
  1. ;
  1. K @PCTM
  1. Q
  1. ;------------------------------------------------------------------
  1. REMARKS(PSODFN) ; Display PATIENT file (#2) REMARKS field (#.091)
  1. ; Input:
  1. ; DFN ; Required ; IEN of Patient file (#2) entry
  1. ;
  1. W !?11,"Remarks: ",$$GET1^DIQ(2,PSODFN_",",.091)
  1. ;
  1. Q
  1. ;------------------------------------------------------------------
  1. ENTER ; PSO CLINICAL ENTER/EDIT OPTION ENTRY POINT.
  1. N PSODFN
  1. PROMPT ;
  1. W @IOF,!?1,"*** CLINICAL ALERT ENTER/EDIT ***"
  1. START ;
  1. W !
  1. S PSODFN=+$$PATIENT G:'PSODFN EXIT W ! ; Prompt for Select PHARMACY PATIENT
  1. D EDITCA(PSODFN) ; Edit CLINICAL ALERTS (multiple)
  1. G START
  1. ;
  1. EXIT ;
  1. Q
  1. ;------------------------------------------------------------------
  1. EDITCA(PSODFN) ; Edit the CLINICAL ALERTS multiple (#109) of file (#55)
  1. ; Input:
  1. ; DFN ; Patient file (#2) entry internal entry number
  1. ;
  1. NEW %,%X,%Y,D,D0,D1,DA,DG,DI,DIC,DIDEL,DIE,DIERR,DIW,DQ,DR,DTOUT,X
  1. ;
  1. S DA=PSODFN
  1. S DIE="^PS(55,",DR="[PSO CLINICAL ALERT ENTER/EDIT]"
  1. ;
  1. D LOCK^DILF($NA(^PS(55,DA))) E D Q
  1. . W $C(7),!?4
  1. . W "Patient ",$$GET1^DIQ(2,DA,.01)," is being edited by another user."
  1. D ^DIE
  1. LOCK -^PS(55,DA)
  1. ;
  1. Q
  1. ;-----------------------------------------------------------------
  1. PATIENT() ; Extrinsic, prompt for 'Select PHARMACY PATIENT: '
  1. ; Output:
  1. ; IEN^Name ; Of the selected Pharmacy Patient file #55 entry
  1. ; Return null if no patient selected
  1. ;
  1. N %,%H,%I,%X,%Y,C,D,D0,DA,DDH,DG,DIC,DILN,DINUM,DIPGM,DIY
  1. N DLAYGO,DTOUT,DUOUT,I,RETURN,X,Y
  1. ;
  1. S RETURN=""
  1. S DIC="^PS(55,"
  1. S DIC(0)="AEMQZ"
  1. D ^DIC I Y>0 S RETURN=+Y_"^"_Y(0,0)
  1. ;
  1. Q RETURN
  1. ;
  1. APPT() ; get appointments up to +/-2 yrs from now
  1. ; return null or name of institution
  1. ; ICR# 10061 - VADPT supported
  1. ; ICR# 10040 - FM read of file 44, field 3 supported
  1. ; ICR# 2171 - $$NS^XUAF4
  1. N I,X,Y,DIV,F4,GL,NOW,VAERR,VAST,XI,XE
  1. S GL=$NA(^UTILITY("VASD",$J)) K @GL
  1. S NOW=$$NOW^XLFDT
  1. S VASD("F")=DT-20000
  1. S VASD("T")=DT+20000
  1. D SDA^VADPT
  1. ; div("F",inst)=total count of visits
  1. ; div("F",0) = appt_dt ^ inst_ptr
  1. ; div("P") set up similarly for past kept appointments
  1. ; ^utility("VASD",$j,inc,"I"/"E")=appt_dt^clinic^status^appt_type
  1. ; only use one visit per day for division count
  1. ; if institution has more than 2 future appts, use that
  1. ; if institution has more than 2 past appts, use that
  1. ; if future appts, use institution of next appt
  1. ; if past appts, use institution of last appt
  1. ; use ^UTILITY("VASD",$J,"D",DATE)="" to track visit days
  1. S F4="",I=0 F S I=$O(@GL@(I)) Q:'I S XI=^(I,"I"),XE=^("E") D Q:F4>2
  1. . N CL,APPT,DATE,INST
  1. . S APPT=+XI,CL=+$P(XI,U,2) Q:'CL
  1. . S DATE=$P(APPT,".") Q:$D(@GL@("D",DATE)) S ^(DATE)=""
  1. . S INST=+$$GET1^DIQ(44,SC,3,"I") Q:'INST
  1. . I APPT>NOW D
  1. . . S Y=1+$G(DIV("F",INST)) I Y>2 S F4=INST Q
  1. . . S DIV("F",INST)=Y I '$D(DIV("F",0)) S DIV("F",0)=APPT_U_INST Q
  1. . . I APPT<DIV("F",0) S DIV("F",0)=APPT_U_INST
  1. . . Q
  1. . I APPT'>NOW D
  1. . . S Y=1+$G(DIV("P",INST)),DIV("F",INST)=Y
  1. . . I '$D(DIV("P",0)) S DIV("F",0)=APPT_U_INST Q
  1. . . I APPT>DIV("P",0) S DIV("F",0)=APPT_U_INST
  1. . . Q
  1. . Q
  1. I 'F4 S (I,X,Y)=0 D
  1. . F S I=$O(DIV("P",I)) Q:'I I DIV("P",I)>Y S X=I,Y=DIV("P",I)
  1. . I X,Y>2 S F4=X Q
  1. . S X=$G(DIV("F",0)) I +X S F4=$P(X,U,2) Q
  1. . S X=$G(DIV("P",0)) I +X S F4=$P(X,U,2)
  1. . Q
  1. I F4 S F4=$P($$NS^XUAF4(F4),U)
  1. K @GL
  1. Q F4