- 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
