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

DG53213P.m

Go to the documentation of this file.
  1. DG53213P ;BP-CIOFO/KEITH - NPCDB patient demographics extraction utility ; 07 Dec 98 12:05 PM
  1. ;;5.3;Registration;**213**;AUG 13, 1993
  1. ;
  1. NOQ ;Suppress option question
  1. S:$G(XPDENV)=1 XPDDIQ("XPZ1")=0 Q
  1. ;
  1. RUN ;Exit if XTMP global exists
  1. N X F X=1:1:10 L ^XTMP("DG53213P",0):1 Q:$T
  1. I '$T D BMES^XPDUTL("Unable to lock global try later!") Q
  1. I $D(^XTMP("DG53213P",0)),$$ZQ() G LQ
  1. ;
  1. BQ ;Queue extraction global build process
  1. N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,DGI,Y,%,%H,%I
  1. S ZTRTN="BUILD^DG53213P",ZTDESC="NPCDB patient demographics extraction"
  1. D NOW^%DTC S (DGQDT,ZTDTH)=XPDQUES("POS1"),ZTIO=""
  1. F DGI=1:1:20 D ^%ZTLOAD Q:$G(ZTSK)
  1. I '$G(ZTSK) D BMES^XPDUTL("Unable to queue extraction, contact Customer Service for assistance!") G LQ
  1. S Y=DGQDT X ^DD("DD")
  1. N X1,X2,DGPDT K ^XTMP("DG53213P")
  1. S X1=DT,X2=30 D C^%DTC S DGPDT=X
  1. S ^XTMP("DG53213P",0)=DGPDT_U_DT_"^Patch DG*5.3*213 NPCDB patient demographics extraction global. Created by user: "_DUZ
  1. S ^XTMP("DG53213P",1,"QUEUED")=DGQDT_U_ZTSK
  1. D BMES^XPDUTL("NPCDB patient demographics extraction queued for "_$P(Y,":",1,2))
  1. D BMES^XPDUTL("Task number: "_ZTSK)
  1. LQ L -^XTMP("DG53213P")
  1. Q
  1. ;
  1. ZQ() ;Determine if process is already queued
  1. N ZTSK S ZTSK=+$P($G(^XTMP("DG53213P",1,"QUEUED")),U,2) Q:'ZTSK 0
  1. D STAT^%ZTLOAD Q:'ZTSK(0) 0 Q:"0345"[ZTSK(1) 0
  1. D BMES^XPDUTL("Patient demographics extraction not queued--")
  1. D BMES^XPDUTL("It appears that this process is already in progress!")
  1. Q 1
  1. ;
  1. BUILD ;Build XTMP global with list of records to send
  1. S (DGFS,DGOUT)=0 F DGI="COUNT","SENT" S ^XTMP("DG53213P",1,DGI)=0
  1. ;
  1. ;Get patient list
  1. S DFN=0 F S DFN=$O(^DPT(DFN)) Q:'DFN!DGOUT D
  1. .I DFN#500=0 D STOP Q:DGOUT
  1. .I $L($P($G(^DPT(DFN,.1)),U)) D SET("CI") Q ;Current inpatient
  1. .I $O(^DGPM("APTT3",DFN,""),-1)>2981001 D SET("DC") Q ;Discharged this Fiscal Year
  1. .I $$OUTPTPR^SDUTL3(DFN) D SET("PC") Q ;Assigned to PC provider
  1. .Q
  1. ;
  1. I DGOUT S DGFS=1 K ^XTMP("DG53213P",2) D REQUE("BUILD^DG53213P"),MSG Q
  1. ;
  1. S ^XTMP("DG53213P",1,"GROUP")=^XTMP("DG53213P",1,"COUNT")\7+1
  1. ;
  1. SEND ;Send group of patient records to NPCDB
  1. S (DGOUT,DGFS)=0,DGGP=^XTMP("DG53213P",1,"GROUP")
  1. S (DGCT,DGERR,DFN)=0
  1. F S DFN=$O(^XTMP("DG53213P",2,DFN)) Q:DGCT>DGGP!'DFN!DGOUT D S1
  1. I 'DGOUT,DGCT<DGGP,$D(^XTMP("DG53213P",2)) G SEND
  1. S ^XTMP("DG53213P",1,"SENT")=^XTMP("DG53213P",1,"SENT")+DGCT
  1. I $$DONE() D MSG K ^XTMP("DG53213P") Q
  1. D REQUE("SEND^DG53213P"),MSG Q
  1. ;
  1. REQUE(ZTRTN) ;Requeue for tomorrow's run
  1. ;Required input: ZTRTN=routine to queue
  1. N ZTDESC,ZTIO,X,Y,%,%H,%I,X1,X2,X
  1. S %H=ZTDTH D YX^%DTC S ZTDTH=X_%
  1. S ZTDESC="NPCDB patient demographics extraction"
  1. S X1=ZTDTH,X2=1 D C^%DTC S (DGQDT,ZTDTH)=X,ZTIO=""
  1. F DGI=1:1:20 D ^%ZTLOAD Q:$G(ZTSK)
  1. I $G(ZTSK) S ^XTMP("DG53213P",1,"QUEUED")=DGQDT_U_ZTSK
  1. S:'$G(ZTSK) DGERR=1
  1. Q
  1. ;
  1. MSG ;Send mail message
  1. N XMSUB,XMDUZ,XMDUN,XMTEXT,XMY,XMZ,DG,DA,DIE,DR
  1. BMSG S XMSUB="NPCDB patient demographics extraction",DGERR=$G(DGERR,0)
  1. S (XMDUZ,XMDUN)="Patch DG*5.3*213"
  1. D M1 S XMTEXT="DG(",XMY(DUZ)="" D ^XMD
  1. ;
  1. CLEAN K DGFS,DGOUT,DGQDT,DGERR,DGI,DFN,DGCT,DGGP,DGPV Q
  1. ;
  1. M1 ;Message text
  1. S DGI=0 I '$$DONE() S Y=DGQDT X ^DD("DD")
  1. D TXT(" *** Status of NPCDB patient demographics extraction ***"),TXT(" ")
  1. I $$DONE(),'DGFS D TXT(" NPCDB patient demographics extraction completed!"),TXT(" ")
  1. I DGERR D TXT("Unable to queue NPCDB patient demographics extraction continuation--"),TXT("Please contact Customer Service for assistance!"),TXT(" ")
  1. D:'DGFS TXT(" Number of records found to send: "_^XTMP("DG53213P",1,"COUNT"))
  1. D:'DGFS TXT("Number of records that have been sent: "_^XTMP("DG53213P",1,"SENT"))
  1. D:DGFS TXT("Extraction process was requested to stop before building a complete list.")
  1. D:DGFS TXT("The partially built list was cleared, extraction will be restarted as follows:")
  1. D TXT(" ")
  1. I '$$DONE()!DGFS,'DGERR D
  1. .D:DGFS TXT(" NPCDB extraction queued for: "_Y)
  1. .D:'DGFS TXT(" Next transmission queued for: "_Y)
  1. .D TXT(" Task number: "_ZTSK)
  1. .Q
  1. I $$DONE(),$D(^XTMP("DG53213P",4)) D
  1. .D TXT("Unable to send these records:")
  1. .S DFN=0 F S DFN=$O(^XTMP("DG53213P",4)) Q:'DFN D
  1. ..D TXT("IFN: "_DFN_" NAME: "_$P($G(^DPT(DFN,0),"UNKNOWN"),U))
  1. ..Q
  1. .Q
  1. Q
  1. ;
  1. TXT(DGT) ;Build message line
  1. ;Required input: DGT=line of text
  1. S DGI=DGI+1,DG(DGI)=DGT Q
  1. ;
  1. DONE() ;Determine if extraction is finished
  1. Q '$D(^XTMP("DG53213P",2))
  1. ;
  1. S1 ;Send a record
  1. I DGCT#100=0 D STOP Q:DGOUT
  1. S DGPV=$$PIVNW^VAFHPIVT(DFN,$$NOW^XLFDT(),4,DFN_";DPT(")
  1. I 'DGPV D Q
  1. .S ^XTMP("DG53213P",2,DFN)=^XTMP("DG53213P",2,DFN)+1
  1. .Q:^XTMP("DG53213P",2,DFN)<3
  1. .S ^XTMP("DG53213P",4,DFN)=""
  1. .K ^XTMP("DG53213P",2,DFN) Q
  1. D XMITFLAG^VAFCDD01(,DGPV)
  1. S ^XTMP("DG53213P",3,DFN)=DGPV,DGCT=DGCT+1
  1. K ^XTMP("DG53213P",2,DFN)
  1. Q
  1. ;
  1. SET(DGR) ;Set patient list node
  1. ;Required input: DGR=reason for inclusion
  1. S ^XTMP("DG53213P",2,DFN)=DGR
  1. S ^XTMP("DG53213P",1,"COUNT")=^XTMP("DG53213P",1,"COUNT")+1
  1. Q
  1. ;
  1. STOP ;Check for stop task request
  1. S:$D(ZTQUEUED) (DGOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q