ACKQAS4 ;HCIOFO/AG - Delete a Quasar Visit ; 04/01/99 ;;3.0;QUASAR;;Feb 11, 2000 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified. ; N DIC,X,Y,ACKVIEN,DFN,ACKPAT,VADM,ACKPATNM,ACKPATSS,ACKCLNNM,ACKDIVNM N ACKDATE,ACKTM,ACKTIME,ACKPIEN,ACKP,ACKIFACE,ACKPCES,ACKDIV,ACKVDT N ACKPCED,ACKPCEDT,DIR,ACKOK,ACKARR ; OPTN ; Introduce option. W @IOF W !!,"This option is used to DELETE an existing A&SP Clinic Visit.",!! ; DATE ; Enter date W ! S DIC("W")="W $$DISPLAY^ACKQUTL3(Y,$X)" S DIC=509850.6,DIC(0)="AEQZ" D ^DIC I X?1"^"1.E W !,"Jumping not allowed.",! G DATE G:Y<0 EXIT G:$D(DIRUT) EXIT ; ; set visit ien variable S ACKVIEN=+Y ; ; Attempt to Lock record if lock fails display error and re-prompt L +^ACK(509850.6,ACKVIEN):2 I '$T D G DATE . W !!,"This record is locked by another process - Please try again later.",!! ; ; display summary details about the visit S (DFN,ACKPAT)=+$$GET1^DIQ(509850.6,ACKVIEN_",",1,"I") D DEM^VADPT S ACKPATNM=VADM(1) S ACKPATSS=$P(VADM(2),U,2) S ACKCLNNM=$$GET1^DIQ(509850.6,ACKVIEN_",",2.6,"E") ; clinic external S ACKDIVNM=$$GET1^DIQ(509850.6,ACKVIEN_",",60,"E") ; division external S ACKDATE=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"E") ; date external S ACKTM=$$GET1^DIQ(509850.6,ACKVIEN_",",55,"I"),ACKTIME=$$FMT^ACKQUTL6(ACKTM,0) S ACKPIEN=$$GET1^DIQ(509850.6,ACKVIEN_",",125,"I") ; pce visit ien S ACKP=$S(ACKPIEN:".",1:"") ; pce flag W !!?2," Patient: ",$E(ACKPATNM,1,35) W ?48," SSN: ",ACKPATSS W !?2," Clinic: ",$E(ACKCLNNM,1,35) W ?48," Visit Date: ",$E(ACKDATE,1,12) W !?2,"Division: ",$E(ACKDIVNM,1,35) W ?48,"Appointment Time: ",ACKTIME_ACKP W ! ; ; determine whether the PCE Interface is ON S ACKIFACE=0 S ACKPCES=$$GET1^DIQ(509850.8,"1,",2,"I") S ACKDIV=$$GET1^DIQ(509850.6,ACKVIEN_",",60,"I") S ACKVDT=$$GET1^DIQ(509850.6,ACKVIEN_",",.01,"I") S ACKPCED=$$GET1^DIQ(509850.83,ACKDIV_",1,",.03,"I") S ACKPCEDT=$$GET1^DIQ(509850.83,ACKDIV_",1,",.08,"I") ; if Site switch is ON and Division switch is ON and Visit Date is ; after PCE Interface Start Date, then Interface is ON. I ACKPCES=1,ACKPCED=1,ACKVDT'