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

ORWCV.m

Go to the documentation of this file.
  1. ORWCV ;SLC/KCM - Background Cover Sheet Load;03/06/20 13:00
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,132,209,214,195,215,260,243,282,302,280,496,377**;Dec 17, 1997;Build 582
  1. ;
  1. ;
  1. ; DBIA 36 Reference to ^DIC(42
  1. ; DBIA 518 Reference to ^SC(
  1. ; DBIA 1096 Reference to ^DGPM("ATID1"
  1. ; DBIA 1894 Reference to GETENC^PXAPI
  1. ; DBIA 1895 Reference to APPT2VST^PXAPI
  1. ; DBIA 2096 Reference to ^SD(409.63
  1. ; DBIA 2437 Reference to ^DGPM(
  1. ; DBIA 2965 Reference to ^DG(405.1
  1. ; DBIA 4011 Access ^XWB(8994)
  1. ; DBIA 4313 Direct R/W permission to capacity mgmt global ^KMPTMP("KMPDT")
  1. ; DBIA 4325 References to AWCMCPR1
  1. ; DBIA 10061 Reference to ^UTILITY
  1. ;
  1. START(VAL,DFN,IP,HWND,LOC,NODO,NEWREM) ; start cover sheet build in background
  1. N ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC,ZTSK,SECT,BACK,X,I,ORLIST,FILE,NODE,ORHTIME,ORX
  1. ; Capacity planning timing code uses ORHTIME
  1. S ORHTIME=$H
  1. S LOC=$G(LOC),NODO=";"_$G(NODO),NEWREM=+$G(NEWREM)
  1. D GETLST^XPAR(.ORX,"SYS^PKG","ORWOR COVER RETRIEVAL NEW","Q")
  1. S I=0 F S I=$O(ORX(I)) Q:'I I $D(^ORD(101.24,+ORX(I),0)) S SECT(+$P(^(0),U,2))=$P(ORX(I),U,2)
  1. D GETLST^XPAR(.ORLIST,"ALL","ORWCV1 COVERSHEET LIST")
  1. S (VAL,BACK,FILE)=""
  1. F S I=$O(ORLIST(I)) Q:'I I $D(^ORD(101.24,$P(ORLIST(I),U,2),0)) S X0=^(0) D
  1. . Q:$P(X0,U,8)'="C"
  1. . S X=$P(X0,U,2)
  1. . I NODO[(";"_X_";") Q ; if in NODO, dont do section
  1. . I '$G(SECT(X)) S VAL=VAL_X_";" ; load section in foreground
  1. . E S BACK=BACK_X_";",FILE=FILE_$P(ORLIST(I),U,2)_";" ; load section in background
  1. Q:BACK=""
  1. S ZTIO="ORW THREAD RESOURCE",ZTRTN="BUILD^ORWCV",ZTDTH=$H
  1. S (ZTSAVE("DFN"),ZTSAVE("IP"),ZTSAVE("HWND"),ZTSAVE("NEWREM"),ZTSAVE("LOC"),ZTSAVE("BACK"),ZTSAVE("FILE"))=""
  1. S ZTDESC="CPRS GUI Background Data Retrieval"
  1. D ^%ZTLOAD I '$D(ZTSK) S VAL=VAL_BACK Q
  1. S NODE="ORWCV "_IP_"-"_HWND_"-"_DFN
  1. K ^XTMP(NODE)
  1. S ^XTMP(NODE,0)=$$FMADD^XLFDT(DT,1)_U_DT_U_"Background CPRS "_ZTSK
  1. ; Start capacity planning timing clock - will be stopped in POLL code
  1. I +$G(^KMPTMP("KMPD-CPRS")) S ^KMPTMP("KMPDT","ORWCV",NODE)=$G(ORHTIME)_"^^"_$G(DUZ)_U_$G(IO("CLNM"))
  1. Q
  1. BUILD ; called in background by task manager, expects DFN, JobID
  1. N NODE,IFLE,ORFNUM,ID,ENT,RTN,INODE,PARAM1,PARAM2,DETAIL,X0,X2
  1. S NODE="ORWCV "_IP_"-"_HWND_"-"_DFN
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. I $G(^XTMP(NODE,"STOP")) K ^XTMP(NODE) Q ; client no longer polling
  1. I '$D(^XTMP(NODE,0)) Q ; XTMP node has been purged
  1. L +^XTMP(NODE):$S($G(DILOCKTM)>0:DILOCKTM,1:5)
  1. S ^XTMP(NODE,"DFN")=DFN
  1. F IFLE=1:1:$L(FILE,";") D
  1. . N $ETRAP,$ESTACK,CALL
  1. . S $ETRAP="D ERR^ORWCV"
  1. . S ORFNUM=$P(FILE,";",IFLE) Q:'$D(^ORD(101.24,+ORFNUM,0))
  1. . S X0=^ORD(101.24,+ORFNUM,0),X2=$G(^(2))
  1. . S ID=$P(X0,U,2),ENT=$P(X0,U,6),RTN=$P(X0,U,5),PARAM1=$P(X2,U)
  1. . S PARAM2=$P(X2,U,2),INODE=$P(X2,U,5),DETAIL=""
  1. . I $P(X0,U,18) S DETAIL=$P($G(^ORD(101.24,+$P(X0,U,18),0)),U,13),DETAIL=$P($G(^XWB(8994,+DETAIL,0)),U) ;DBIA 4011
  1. . I '$L(INODE) Q
  1. . I '$L(ENT) S LST(IFLE)="0^ERROR: Missing ENTRY POINT field in file 101.24 for "_$P(X0,U)_", IFN="_+ORFNUM D LST2XTMP(INODE) Q
  1. . I '$L(RTN) S LST(IFLE)="0^ERROR: Missing ROUTINE field in file 101.24 for "_$P(X0,U)_", IFN="_+ORFNUM D LST2XTMP(INODE) Q
  1. . I '$L($T(@(ENT_U_RTN))) S LST(IFLE)="0^ERROR: "_ENT_"~"_RTN_" does not exist. See file 101.24 entry: "_$P(X0,U)_", IFN="_+ORFNUM D LST2XTMP(INODE) Q
  1. . S CALL="(.LST,DFN"
  1. . I ID=50 S CALL="REM^ORWCV"_CALL_","""_ENT_U_RTN_""""
  1. . E S CALL=ENT_U_RTN_CALL
  1. . I $L(PARAM1) S CALL=CALL_",PARAM1"
  1. . I $L(PARAM2) S CALL=CALL_",PARAM2"
  1. . S CALL=CALL_")"
  1. . D @(CALL),LST2XTMP(INODE)
  1. S ^XTMP(NODE,"DONE")=1
  1. I $G(^XTMP(NODE,"STOP")) K ^XTMP(NODE)
  1. L -^XTMP(NODE)
  1. Q
  1. ERR ;Error trap
  1. I $D(NODE),$D(INODE) K LST S LST(0)="",LST(1)="0^ERROR DURING COVER SHEET BUILD:"_$$EC^%ZOSV
  1. D @^%ZOSF("ERRTN") ;file error
  1. S $ECODE=""
  1. Q
  1. LST2XTMP(ID) ; put the list in ^XTMP(NODE,ID)
  1. I $G(^XTMP(NODE,"STOP")) Q
  1. N I
  1. I $L($G(DETAIL)) S I=0 F S I=$O(LST(I)) Q:'I S $P(LST(I),U,12)=DETAIL
  1. K ^XTMP(NODE,ID) M ^XTMP(NODE,ID)=LST S ^XTMP(NODE,ID)=1 K LST
  1. S ^XTMP(NODE,"PANELS",ID)=""
  1. Q
  1. POLL(LST,DFN,IP,HWND,ONLYID) ; poll for completed cover sheet parts
  1. N ILST,ID,NODE,DONE
  1. I '$D(DFN)!('$D(IP))!('$D(HWND)) S LST="" Q
  1. S NODE="ORWCV "_IP_"-"_HWND_"-"_DFN,ILST=0,DONE=0
  1. I '$D(^XTMP(NODE,"DFN")) Q
  1. I ^XTMP(NODE,"DFN")'=DFN S LST(1)="~DONE=1" Q
  1. I $G(^XTMP(NODE,"DONE")) S ILST=ILST+1,LST(ILST)="~DONE=1",DONE=1
  1. I $D(ONLYID) D
  1. . D CHK(NODE,ONLYID,.ILST,.LST)
  1. . I DONE,$D(^XTMP(NODE,"PANELS")) S DONE=0
  1. I '$D(ONLYID) S ID="" F S ID=$O(^XTMP(NODE,ID)) Q:ID="" D
  1. . D CHK(NODE,ID,.ILST,.LST)
  1. ; Stop capacity planning timing clock - was started in START code
  1. I DONE K ^XTMP(NODE) I +$G(^KMPTMP("KMPD-CPRS")) S $P(^KMPTMP("KMPDT","ORWCV",NODE),U,2)=$H
  1. Q
  1. CHK(NODE,ID,ILST,LST) ; check an individual panel
  1. N I
  1. I '$G(^XTMP(NODE,ID)) Q
  1. S ILST=ILST+1,LST(ILST)="~"_ID
  1. S I=0 F S I=$O(^XTMP(NODE,ID,I)) Q:'I S ILST=ILST+1,LST(ILST)="i"_^(I)
  1. K ^XTMP(NODE,ID),^XTMP(NODE,"PANELS",ID)
  1. Q
  1. STOP(OK,DFN,IP,HWND) ; stop cover sheet data retrieval
  1. S NODE="ORWCV "_IP_"-"_HWND_"-"_DFN,ILST=0,DONE=0
  1. S ^XTMP(NODE,"STOP")=1,OK=1
  1. L +^XTMP(NODE):$S($G(DILOCKTM)>0:DILOCKTM,1:5)
  1. I $G(^XTMP(NODE,"DONE")) K ^XTMP(NODE)
  1. L -^XTMP(NODE)
  1. Q
  1. CLEAN ; clean up ^XTMP nodes
  1. S X="ORWCV"
  1. F S X=$O(^XTMP(X)) Q:$E(X,1,5)'="ORWCV" W !,X K ^XTMP(X)
  1. Q
  1. LAB(LST,DFN) ; return labs for patient
  1. D:$L($T(STRT2^AWCMCPR1)) STRT2^AWCMCPR1
  1. D LIST^ORQOR1(.LST,DFN,"LAB",4,"T-"_$$RNGLAB(DFN),"T","AW",1)
  1. D:$L($T(END^AWCMCPR1)) END^AWCMCPR1
  1. Q
  1. REM(LST,DFN,OLDCALL) ; return reminders for patient
  1. I $L($T(STRT3^AWCMCPR1))>0 D STRT3^AWCMCPR1
  1. I $G(NEWREM) D APPL^ORQQPXRM(.LST,DFN,LOC)
  1. I '$G(NEWREM) D @(OLDCALL_"(.LST,DFN)")
  1. I $L($T(END^AWCMCPR1))>0 D END^AWCMCPR1
  1. Q
  1. VST1(ORVISIT,DFN,BEG,END,SKIP) ;
  1. N ERR,ERRMSG
  1. S ERR=0 ; kludge to return errors
  1. Q:'$G(DFN)
  1. D VST(.ORVISIT,DFN,.BEG,.END,$G(SKIP),.ERR,.ERRMSG)
  1. I ERR K ORVISIT S ORVISIT(1)=ERRMSG
  1. Q
  1. ;
  1. TEST ;D VST(.ZZZ,76,2950101,3050401,777,1,1)
  1. Q
  1. VST(ORVISIT,DFN,BEG,END,SKIP,ERR,ERRMSG) ; return appts/admissions for patient
  1. N CHECKERR,VAERR,VASD,BDT,COUNT,DTM,EDT,LOC,NOW,ORQUERY,ORLST,STI,STS,TODAY,I,J,K,XI,XE,X
  1. S CHECKERR=($G(ERR)=0) ; kludge to check for errors
  1. S NOW=$$NOW^XLFDT(),TODAY=$P(NOW,".",1)
  1. I '$G(BEG) S BEG=$$X2FM($$RNGVBEG)
  1. I '$G(END) S END=$$X2FM($$RNGVEND)+0.2359
  1. S COUNT=0
  1. K ^TMP("ORVSTLIST",$J)
  1. S VAERR=0
  1. I END>NOW D Q:VAERR ; get future encounters, past cancels/no-shows from VADPT
  1. . S VASD("F")=BEG
  1. . S VASD("T")=END
  1. . S VASD("W")="123456789"
  1. . D SDA^ORQRY01(.ERR,.ERRMSG)
  1. . I CHECKERR,ERR K ^UTILITY("VASD",$J) S ORVISIT(1)=ERRMSG Q ;IA 10061
  1. . S I=0 F S I=$O(^UTILITY("VASD",$J,I)) Q:'I D
  1. . . S XI=^UTILITY("VASD",$J,I,"I"),XE=^("E")
  1. . . S DTM=$P(XI,U),IEN=$P(XI,U,2),STI=$P(XI,U,3)
  1. . . S LOC=$P(XE,U,2),STS=$P(XE,U,3)
  1. . . I DTM<TODAY,(STI=""!(STI["I")!(STI="NT")) Q ; no prior kept appts
  1. . . S ^TMP("ORVSTLIST",$J,DTM,"A",1)="A;"_DTM_";"_IEN_U_DTM_U_LOC_U_STS
  1. . K ^UTILITY("VASD",$J)
  1. I BEG'>NOW D ;past encounters from ACRP Toolkit - set in CALLBACK
  1. . S BDT=BEG
  1. . S EDT=$S(END<NOW:END,1:NOW)
  1. . D COVER^SDRROR
  1. . D OPEN^SDQ(.ORQUERY)
  1. . I '$$ERRCHK^SDQUT() D INDEX^SDQ(.ORQUERY,"PATIENT/DATE","SET")
  1. . I '$$ERRCHK^SDQUT() D PAT^SDQ(.ORQUERY,DFN,"SET")
  1. . I '$$ERRCHK^SDQUT() D DATE^SDQ(.ORQUERY,BDT,EDT,"SET")
  1. . I '$$ERRCHK^SDQUT() D
  1. . . S ORLST=$NA(^TMP("ORVSTLIST",$J))
  1. . . D SCANCB^SDQ(.ORQUERY,"D CALLBACK^ORWCV(Y,Y0,.ORLST,.ORSTOP)","SET")
  1. . I '$$ERRCHK^SDQUT() D ACTIVE^SDQ(.ORQUERY,"TRUE","SET")
  1. . I '$$ERRCHK^SDQUT() D SCAN^SDQ(.ORQUERY,"FORWARD")
  1. . D CLOSE^SDQ(.ORQUERY)
  1. ;
  1. I '$G(SKIP) D
  1. . N TIM,MOV,X0,Y,MTIM,XTYP,XLOC,HLOC,EARLY,DONE ; admits
  1. . S EARLY=$$X2FM($$RNGVBEG),DONE=0
  1. . S TIM="" F S TIM=$O(^DGPM("ATID1",DFN,TIM)) Q:TIM'>0 D Q:DONE
  1. . . S MOV=0 F S MOV=$O(^DGPM("ATID1",DFN,TIM,MOV)) Q:MOV'>0 D Q:DONE
  1. . . . S X0=^DGPM(MOV,0),MTIM=$P(X0,U)
  1. . . . I MTIM<EARLY S DONE=1 Q
  1. . . . S XTYP=$P($G(^DG(405.1,+$P(X0,U,4),0)),U,1)
  1. . . . S XLOC=$P($G(^DIC(42,+$P(X0,U,6),0)),U,1),HLOC=+$G(^(44))
  1. . . . S ^TMP("ORVSTLIST",$J,MTIM,"I",1)="I;"_MTIM_";"_HLOC_U_MTIM_U_"Inpatient Stay"_U_XLOC_U_XTYP
  1. ;
  1. S COUNT=0
  1. S I=0 F S I=$O(^TMP("ORVSTLIST",$J,I)) Q:'I D
  1. . S J="" F S J=$O(^TMP("ORVSTLIST",$J,I,J)) Q:J="" D
  1. . . S K=0 F S K=$O(^TMP("ORVSTLIST",$J,I,J,K)) Q:'K D
  1. . . . S COUNT=COUNT+1
  1. . . . S ORVISIT(COUNT)=^TMP("ORVSTLIST",$J,I,J,K)
  1. K ^TMP("ORVSTLIST",$J)
  1. Q
  1. CALLBACK(IEN,NODE0,ARRAY,STOP) ; called back from ACRP Toolkit for encounters
  1. ;
  1. ; IEN and NODE0 relate to Outpatient Encounter File
  1. ; set STOP to 1 if need to quit
  1. ;
  1. N COUNT,DTM,LOC,OOS,TYPE,XSTAT,XLOC
  1. S DTM=+NODE0,COUNT=1
  1. S LOC=$P(NODE0,U,4)
  1. S XLOC=$P($G(^SC(+LOC,0)),U),OOS=$G(^("OOS"))
  1. I OOS Q ; ignore OOS locations
  1. I $P(NODE0,U,6) Q ; not parent encounter
  1. S XSTAT=$P($G(^SD(409.63,+$P(NODE0,U,12),0)),U)
  1. S TYPE=$S($P(NODE0,U,8)=1:"A",1:"V")
  1. I TYPE="V",$D(@ARRAY@(DTM,"V")) S COUNT=$O(@ARRAY@(DTM,"V","A"),-1)+1 ; same d/t
  1. S @ARRAY@(DTM,TYPE,COUNT)=TYPE_";"_DTM_";"_LOC_U_DTM_U_XLOC_U_XSTAT
  1. Q
  1. DTLVST(RPT,DFN,IEN,APPTINFO) ; return progress notes / discharge summary
  1. N VISIT
  1. I $P(APPTINFO,";")="A" D Q
  1. . S VISIT=$$APPT2VST^PXAPI(DFN,$P(APPTINFO,";",2),$P(APPTINFO,";",3))
  1. . I VISIT=0 S VISIT=+$$GETENC^PXAPI(DFN,$P(APPTINFO,";",2),$P(APPTINFO,";",3))
  1. . D DETNOTE^ORQQVS(.RPT,DFN,VISIT)
  1. . N X1,X2 S (X1,X2)=0 F S X1=$O(RPT(X1)) Q:X1'>0 S X2=X1 ;get the last entry in the RPT list
  1. . I X2'>0 S X2=1
  1. . N XSD,XSDDT,SDURL
  1. . S XSD=$P(APPTINFO,";",3),XSDDT=$P(APPTINFO,";",2) ;look up the entry in the appointment multiple and get the url
  1. . Q:'$D(^SC($G(XSD),0)) ; No clinic
  1. . Q:'$D(^SC($G(XSD),"S",XSDDT)) ; No appointment at that time
  1. . K XX1 S XX1=0 F S XX1=$O(^SC(XSD,"S",XSDDT,1,XX1)) Q:$G(XX1)'>0 D
  1. . . Q:$P(^SC(XSD,"S",XSDDT,1,XX1,0),"^",1)'=DFN
  1. . . Q:$G(SDURL)'=""
  1. . . S SDURL=$G(^SC(XSD,"S",XSDDT,1,XX1,"URL"))
  1. . S RPT(X2)=$G(SDURL)
  1. . K XSD,XSDDT,SDURL
  1. I $P(APPTINFO,";")="V" D Q
  1. . S VISIT=+$$GETENC^PXAPI(DFN,$P(APPTINFO,";",2),$P(APPTINFO,";",3))
  1. . D DETNOTE^ORQQVS(.RPT,DFN,VISIT)
  1. I $P(APPTINFO,";")="I" D Q
  1. . S VISIT=+$$GETENC^PXAPI(DFN,$P(APPTINFO,";",2),$P(APPTINFO,";",3))
  1. . D DETSUM^ORQQVS(.RPT,DFN,VISIT)
  1. . K ^TMP("PXKENC",$J)
  1. I $P(APPTINFO,";")="R" D RCDTL^SDRROR
  1. Q
  1. X2FM(X) ; return FM date given relative date
  1. N %DT S %DT="TS" D ^%DT
  1. Q Y
  1. RNGLAB(DFN) ; return days back for patient
  1. N INPT,PAR,LOC
  1. S INPT=0 I $L($G(^DPT(DFN,.1))) S INPT=1,LOC=^(.1)
  1. S PAR="ORQQLR DATE RANGE "_$S(INPT:"INPT",1:"OUTPT")
  1. Q $$GET^XPAR("ALL"_$S(INPT:"^LOC."_LOC,1:""),PAR,1,"I")
  1. ;
  1. RNGVBEG() ; return start date for encounters
  1. Q $$GET^XPAR("ALL","ORQQCSDR CS RANGE START",1,"I")
  1. ;
  1. RNGVEND() ; return stop date for encounters
  1. Q $$GET^XPAR("ALL","ORQQCSDR CS RANGE STOP",1,"I")
  1. ;
  1. RANGES(REC,DFN) ; return ranges given a patient
  1. N REC
  1. S REC=$$RNGLAB(DFN)_U_$$RNGVBEG_U_$$RNGVEND
  1. Q