source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY153.m

ORY153 ;SLC/JLI Hep-C Post Init ; Feb 04, 2003@11:44:15
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**153**;Dec 17, 1997
 ;
PRE ;Pre-init
 Q
POST ;Post-init
 N OLDVAL
 S OLDVAL=""
 S OLDVAL=$$GET^XPAR("SYS^PKG","ORHEPC ABNORMAL START",1,"I")
 D MAIN
 D:$L(OLDVAL) EN^XPAR("SYS","ORHEPC ABNORMAL START",1,OLDVAL)
 D UDABS
 D UDRPTS
 D QUE ;rebuild ARS xref this version
 Q
 ;
MAIN ; main (initial) parameter transport routine
 K ^TMP($J,"XPARRSTR")
 N ENT,IDX,ROOT,REF,VAL,I
 S ROOT=$NAME(^TMP($J,"XPARRSTR")),ROOT=$E(ROOT,1,$L(ROOT)-1)_","
LOAD ; load data into ^TMP (expects ROOT to be defined)
 S I=1 F  S REF=$T(DATA+I) Q:REF=""  S VAL=$T(DATA+I+1) D
 . S I=I+2,REF=$P(REF,";",3,999),VAL=$P(VAL,";",3,999)
 . S @(ROOT_REF)=VAL
 Q
XX2 S IDX=0,ENT="PKG."_"ORDER ENTRY/RESULTS REPORTING"
 F  S IDX=$O(^TMP($J,"XPARRSTR",IDX)) Q:'IDX  D
 . N PAR,INST,VAL,ERR
 . S PAR=$P(^TMP($J,"XPARRSTR",IDX,"KEY"),U),INST=$P(^("KEY"),U,2)
 . M VAL=^TMP($J,"XPARRSTR",IDX,"VAL")
 . D EN^XPAR(ENT,PAR,INST,.VAL,.ERR)
 K ^TMP($J,"XPARRSTR")
 Q
 ;
UDABS ;Update abnormal result start date PKG level to installation date
 ;update date range in abnormal result report
 D EN^XPAR("PKG","ORHEPC ABNORMAL START",1,$$DT^XLFDT())
 N DRANGEID,ABSID,STDT,IX,SD,TD,TXTC,DIFF
 S (IX,ABSID,STDT,SD,TX,JX,DIFF)=0,TXTC=""
 S ABSID=$O(^ORD(102.21,"B","RPT ABNORMAL RESULTS",0))
 S DRANGEID=$O(^ORD(102.21,"B","CTP SEARCH DATE RANGE",0))
 S STDT=$$GET^XPAR("SYS^PKG","ORHEPC ABNORMAL START",1,"I")
 S TD=$$DT^XLFDT()
 S DIFF=$$FMDIFF^XLFDT(STDT,TD,1)
 S DIFF=+$FN(DIFF,"T")
 I DIFF>184 S STDT="T-184"
 S SD=$$FMTE^XLFDT(STDT)
 S TD=$$FMTE^XLFDT(TD)
 S TXTC="from "_SD_" through "_TD
 F  S IX=$O(^ORD(102.21,ABSID,1,IX)) Q:('IX)!JX  D
 . I $P(^ORD(102.21,ABSID,1,IX,0),U,2)=DRANGEID D
 . . S $P(^ORD(102.21,ABSID,1,IX,0),U,4)=TXTC
 . . S ^ORD(102.21,ABSID,1,IX,1,1,0)=STDT_":T"
 . . K ^ORD(102.21,ABSID,1,IX,1,"B")
 . . S ^ORD(102.21,ABSID,1,IX,1,"B",STDT_":T",1)="",JX=1 Q
 Q
UDRPTS ;
CSLTRPT ;
 N IX,JX,RPTID,CTGVL
 S (IX,JX,RPTID,CTGVL)=0
 S RPTID=$O(^ORD(102.21,"B","RPT CONSULT FOLLOW-UP",0))
 F  S IX=$O(^ORD(102.21,RPTID,1,IX)) Q:('IX)!JX  D
 . I $P(^(IX,0),U,4)="ALL SERVICES" D
 . . S CTGVL=$O(^ORD(100.98,"B","CSLT",0))
 . . S ^ORD(102.21,RPTID,1,IX,1,1,0)=CTGVL
 . . K ^ORD(102.21,RPTID,1,IX,1,"B") S ^ORD(102.21,RPTID,1,IX,1,"B",CTGVL,1)="",JX=1
SCHRPT ;
 S (IX,JX,RPTID,CTGVL)=0
 S RPTID=$O(^ORD(102.21,"B","RPT SCHEDULED/DUE ACTIVITY",0))
 F  S IX=$O(^ORD(102.21,RPTID,1,IX)) Q:('IX)!JX  D
 . I $P(^(IX,0),U,4)="IMAGING" D
 . . S CTGVL=$O(^ORD(100.98,"B","IMAGING",0))
 . . S ^ORD(102.21,RPTID,1,IX,1,1,0)=CTGVL
 . . K ^ORD(102.21,RPTID,1,IX,1,"B") S ^ORD(102.21,RPTID,1,IX,1,"B",CTGVL,1)=""
 Q
QUE ; -- Task xref job
 N ZTIO,ZTDTH,ZTDESC,ZTRTN,ZTSK,ZTSAVE
 S ZTIO="",ZTDTH=$H,ZTDESC="Rebuild ARS xref on Orders file #100"
 S ZTRTN="ARS^ORY153" D ^%ZTLOAD
 S X="Task "_$S($G(ZTSK):"#"_ZTSK,1:"not")_" started to rebuild ^OR(100,""ARS"")." D BMES^XPDUTL(X)
 Q
ARS ; -- Add Patient subscript to xref for test sites
 N ORFIRST,ORIDX,ORIFN,ORVP,ORDT
 S ORIDX=$Q(^OR(100,"ARS")) Q:ORIDX'["ARS"  Q:$L(ORIDX,",")>4
 S ORFIRST=+$P(ORIDX,",",4) F  S ORIDX=$Q(@ORIDX) Q:ORIDX'?1"^OR(100,""ARS"",".E  S ORIFN=+$P(ORIDX,",",4) S:ORIFN<ORFIRST ORFIRST=ORIFN
 K ^OR(100,"ARS") S ORIFN=ORFIRST-.1
 F  S ORIFN=$O(^OR(100,ORIFN)) Q:ORIFN<1  D
 . S ORDT=+$G(^OR(100,ORIFN,7)) Q:ORDT<1  S ORVP=$P($G(^(0)),U,2)
 . S ^OR(100,"ARS",ORVP,9999999-ORDT,ORIFN)=""
 Q
DATA ; parameter data
 ;;12848,"KEY")
 ;;ORHEPC ABNORMAL START^1
 ;;12848,"VAL")
 ;;FEB 14, 2003