AGIVDRIV ;IHS/SD/EFG - DRIVER TO EXTRACT PT DATA FOR ENVOY (VERIQUEST) ; 9/30/04
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
N ASUFAC,AGPOP,SD,SDT,DFN,AGRECCNT,AGRECWRT
D INIT ;
D OPENIO ;
I 'AGPOP D
.D AGIVVIST
E D
.W #,"Error Creating or Opening Host file"
D CLOSE^%ZISH("AGDEVICE") ;AGDEVICE contains host file name
W !,"Records read: ",AGRECCNT
W !,"Records wrtn: ",AGRECWRT
D UPDTAGDT
Q
INIT ;
S (AGRECCNT,AGRECWRT,AGPOP)=0 ;Variable used to halt this process
S (SD,SDT,DFN)=""
Q
OPENIO ;
D ASUFAC
I 'AGPOP D
.D NOW^%DTC
.S FMDT=X
.D YX^%DTC
.D DATSTAMP
.S AGFILNAM="AGVERI"_ASUFAC_"."_FMDT_HHMMSS
D OPEN^%ZISH("AGDEVICE","/usr3/dsd/reisch/",AGFILNAM,"W")
U IO
Q
ASUFAC ;
I +$G(DUZ(2))=0 D
.S AGPOP=1 ;No DUZ(2) value
E D
.S AULOCREC=$G(^AUTTLOC(DUZ(2),0))
.S ASUFAC=$P(AULOCREC,"^",10)
.I AULOCREC=""!(+ASUFAC=0) D
..S AGPOP=2 ;No Location record or ASUFAC value
Q
DATSTAMP ;
D NOW^%DTC
S FMDT=X
D YX^%DTC
S AGTIME=$P(Y,"@",2)
S HHMMSS=$TR(AGTIME,":")
I $L(HHMMSS)=4 S HHMMSS=HHMMSS_"00"
Q
UPDTAGDT ;
;UPDATE THE AUDIT FILE WITH APPROPRIATE DATA
Q
AGIVVIST ;
;GET TOMORROWS DATE
START D NOW^%DTC S X1=X,X2=0 D C^%DTC S ZDT=X_".0001",EDT=X_".2359"
;LOOP ON FILE 44 B XREF
S DIV=$G(DUZ(2)) Q:DIV']""
LOOPA S SD=0 F SDXX=0:0 S SD=$O(^SC("B",SD)) Q:SD="" D CLIN
Q
CLIN S SDFL=0 F SC=0:0 S SC=$O(^SC("B",SD,SC)) Q:'SC I $D(^SC(SC,0)),$P(^(0),"^",3)="C" D LOOP
Q
LOOP S SDB=0 F SDT=ZDT:0 S SDT=$O(^SC(SC,"S",SDT)) Q:'SDT!(SDT>EDT) D MORE
Q
MORE I $D(^SC(SC,"S",SDT,1)) F K=0:0 S K=$O(^SC(SC,"S",SDT,1,K)) Q:'K I $P(^(K,0),"^",9)'["C" D PTL
Q
PTL S DFN=$P(^SC(SC,"S",SDT,1,K,0),"^",1)
S AGRECCNT=AGRECCNT+1
Q:$S('$D(^DPT(DFN,"S",SDT,0)):1,$P(^(0),"^",2)["C"!($P(^(0),"^",2)["N"):1,1:0)
S AGRECWRT=AGRECWRT+1
S PATNAME=$P(^DPT(DFN,0),"^",1)
S PATNAME=$E(PATNAME,1,15)
S SSN=$P($G(^DPT(DFN,0)),"^",9)
;Get the DOB and convert it to external format (i.e. OCT 31,1949)
S Y=$P($G(^(0)),"^",3)
X ^DD("DD")
S DOB=Y
S HRN=$P(^AUPNPAT(DFN,41,DIV,0),"^",2)
S Y=$P(SDT,".",1)
X ^DD("DD")
S APPTDAT=Y
I $L(APPTDAT)=10 S APPTDAT=$E(APPTDAT,1,3)_" "_$E(APPTDAT,4,10)
S APPTIM=$P(SDT,".",2)
I $L(APPTIM)<4 D
.S APPTIM=$E((APPTIM_"00"),1,4)
S APPTIM=$E(APPTIM,1,2)_":"_$E(APPTIM,3,4)
S NAME=$P(SD,1,15)
I AGRECCNT=1 D
.W APPTDAT,?13,APPTIM,?20,PATNAME,?37,SSN,?50,DOB,?63,HRN,?70,$E(SD,1,10)
E D
.W !,APPTDAT,?13,APPTIM,?20,PATNAME,?37,SSN,?50,DOB,?63,HRN,?70,$E(SD,1,10)
Q
AGIVDRIV ;IHS/SD/EFG - DRIVER TO EXTRACT PT DATA FOR ENVOY (VERIQUEST) ; 9/30/04
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 NEW ASUFAC,AGPOP,SD,SDT,DFN,AGRECCNT,AGRECWRT
+3 ;
DO INIT
+4 ;
DO OPENIO
+5 IF 'AGPOP
Begin DoDot:1
+6 DO AGIVVIST
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 WRITE #,"Error Creating or Opening Host file"
End DoDot:1
+9 ;AGDEVICE contains host file name
DO CLOSE^%ZISH("AGDEVICE")
+10 WRITE !,"Records read: ",AGRECCNT
+11 WRITE !,"Records wrtn: ",AGRECWRT
+12 DO UPDTAGDT
+13 QUIT
INIT ;
+1 ;Variable used to halt this process
SET (AGRECCNT,AGRECWRT,AGPOP)=0
+2 SET (SD,SDT,DFN)=""
+3 QUIT
OPENIO ;
+1 DO ASUFAC
+2 IF 'AGPOP
Begin DoDot:1
+3 DO NOW^%DTC
+4 SET FMDT=X
+5 DO YX^%DTC
+6 DO DATSTAMP
+7 SET AGFILNAM="AGVERI"_ASUFAC_"."_FMDT_HHMMSS
End DoDot:1
+8 DO OPEN^%ZISH("AGDEVICE","/usr3/dsd/reisch/",AGFILNAM,"W")
+9 USE IO
+10 QUIT
ASUFAC ;
+1 IF +$GET(DUZ(2))=0
Begin DoDot:1
+2 ;No DUZ(2) value
SET AGPOP=1
End DoDot:1
+3 IF '$TEST
Begin DoDot:1
+4 SET AULOCREC=$GET(^AUTTLOC(DUZ(2),0))
+5 SET ASUFAC=$PIECE(AULOCREC,"^",10)
+6 IF AULOCREC=""!(+ASUFAC=0)
Begin DoDot:2
+7 ;No Location record or ASUFAC value
SET AGPOP=2
End DoDot:2
End DoDot:1
+8 QUIT
DATSTAMP ;
+1 DO NOW^%DTC
+2 SET FMDT=X
+3 DO YX^%DTC
+4 SET AGTIME=$PIECE(Y,"@",2)
+5 SET HHMMSS=$TRANSLATE(AGTIME,":")
+6 IF $LENGTH(HHMMSS)=4
SET HHMMSS=HHMMSS_"00"
+7 QUIT
UPDTAGDT ;
+1 ;UPDATE THE AUDIT FILE WITH APPROPRIATE DATA
+2 QUIT
AGIVVIST ;
+1 ;GET TOMORROWS DATE
START DO NOW^%DTC
SET X1=X
SET X2=0
DO C^%DTC
SET ZDT=X_".0001"
SET EDT=X_".2359"
+1 ;LOOP ON FILE 44 B XREF
+2 SET DIV=$GET(DUZ(2))
IF DIV']""
QUIT
LOOPA SET SD=0
FOR SDXX=0:0
SET SD=$ORDER(^SC("B",SD))
IF SD=""
QUIT
DO CLIN
+1 QUIT
CLIN SET SDFL=0
FOR SC=0:0
SET SC=$ORDER(^SC("B",SD,SC))
IF 'SC
QUIT
IF $DATA(^SC(SC,0))
IF $PIECE(^(0),"^",3)="C"
DO LOOP
+1 QUIT
LOOP SET SDB=0
FOR SDT=ZDT:0
SET SDT=$ORDER(^SC(SC,"S",SDT))
IF 'SDT!(SDT>EDT)
QUIT
DO MORE
+1 QUIT
MORE IF $DATA(^SC(SC,"S",SDT,1))
FOR K=0:0
SET K=$ORDER(^SC(SC,"S",SDT,1,K))
IF 'K
QUIT
IF $PIECE(^(K,0),"^",9)'["C"
DO PTL
+1 QUIT
PTL SET DFN=$PIECE(^SC(SC,"S",SDT,1,K,0),"^",1)
+1 SET AGRECCNT=AGRECCNT+1
+2 IF $SELECT('$DATA(^DPT(DFN,"S",SDT,0))
QUIT
+3 SET AGRECWRT=AGRECWRT+1
+4 SET PATNAME=$PIECE(^DPT(DFN,0),"^",1)
+5 SET PATNAME=$EXTRACT(PATNAME,1,15)
+6 SET SSN=$PIECE($GET(^DPT(DFN,0)),"^",9)
+7 ;Get the DOB and convert it to external format (i.e. OCT 31,1949)
+8 SET Y=$PIECE($GET(^(0)),"^",3)
+9 XECUTE ^DD("DD")
+10 SET DOB=Y
+11 SET HRN=$PIECE(^AUPNPAT(DFN,41,DIV,0),"^",2)
+12 SET Y=$PIECE(SDT,".",1)
+13 XECUTE ^DD("DD")
+14 SET APPTDAT=Y
+15 IF $LENGTH(APPTDAT)=10
SET APPTDAT=$EXTRACT(APPTDAT,1,3)_" "_$EXTRACT(APPTDAT,4,10)
+16 SET APPTIM=$PIECE(SDT,".",2)
+17 IF $LENGTH(APPTIM)<4
Begin DoDot:1
+18 SET APPTIM=$EXTRACT((APPTIM_"00"),1,4)
End DoDot:1
+19 SET APPTIM=$EXTRACT(APPTIM,1,2)_":"_$EXTRACT(APPTIM,3,4)
+20 SET NAME=$PIECE(SD,1,15)
+21 IF AGRECCNT=1
Begin DoDot:1
+22 WRITE APPTDAT,?13,APPTIM,?20,PATNAME,?37,SSN,?50,DOB,?63,HRN,?70,$EXTRACT(SD,1,10)
End DoDot:1
+23 IF '$TEST
Begin DoDot:1
+24 WRITE !,APPTDAT,?13,APPTIM,?20,PATNAME,?37,SSN,?50,DOB,?63,HRN,?70,$EXTRACT(SD,1,10)
End DoDot:1
+25 QUIT
