BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ;;1.41;BSDX;;Sep 29, 2010 ; ; NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP ;Entry point for debugging ; ;D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)") Q ; NOSHOW(BSDXY,BSDXAPTID,BSDXNS) ;EP ;Called by BSDX NOSHOW ;Sets appointment noshow flag in BSDX APPOINTMENT file ;BSDXAPTID is entry number in BSDX APPOINTMENT file ;BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO ;Calls CANCEL^BSDAPI to set noshow data in ^DPT ;Returns error code in recordset field ERRORID ; N BSDXNOD,BSDXPATID,BSDXSTART,BSDXID,BSDXI,BSDXZ,BSDXERR,BSDXMSG,BSDXFDA,BSDXIENS N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol ; D ^XBKVAR S X="ETRAP^BSDX31",@^%ZOSF("TRAP") S BSDXI=0 K ^BSDXTMP($J) S BSDXY="^BSDXTMP("_$J_")" S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30) S BSDXI=BSDXI+1 TSTART I '+BSDXAPTID D ERR(0,"BSDX31: Invalid Appointment ID") Q I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(0,"BSDX31: Invalid Appointment ID") Q S BSDXNS=+BSDXNS I BSDXNS'=1&(BSDXNS'=0) D ERR(0,"BSDX31: Invalid No Show value") Q ; ;Edit BSDX APPOINTMENT entry NOSHOW field S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) I BSDXNOD="" D ERR(0,"BSDX31: Invalid Appointment ID") Q S BSDXPATID=$P(BSDXNOD,U,5) S BSDXSTART=$P(BSDXNOD,U) ; D BSDXNOS(BSDXAPTID,BSDXNS) I $D(BSDXMSG("DIERR")) S BSDXMSG=$G(BSDXMSG("DIERR",1,"TEXT",1)) D ERR(0,"BSDX31: "_BSDXMSG) Q ; S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I $G(BSDXZ)]"" S BSDXERR="BSDX31: APNOSHO Returned: "_BSDXZ D ERR(0,BSDXERR) Q . S BSDXNOD=^BSDXRES(BSDXSC1,0) . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APNOSHO(.BSDXZ,BSDXSC1,BSDXPATID,BSDXSTART,BSDXNS) ; TCOMMIT S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)="1^"_$C(30) S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(31) Q ; APNOSHO(BSDXZ,BSDXSC1,BSDXDFN,BSDXSD,BSDXNS) ; ; update file 2 info ;Set noshow for patient BSDXDFN in clinic BSDXSC1 ;at time BSDXSD N BSDXC,%H,BSDXCDT,BSDXIEN N BSDXIENS,BSDXFDA,BSDXMSG S %H=$H D YMD^%DTC S BSDXCDT=X+% ; S BSDXIENS=BSDXSD_","_BSDXDFN_"," I +BSDXNS D . S BSDXFDA(2.98,BSDXIENS,3)="N" . S BSDXFDA(2.98,BSDXIENS,14)=DUZ . S BSDXFDA(2.98,BSDXIENS,15)=BSDXCDT E D . S BSDXFDA(2.98,BSDXIENS,3)="" . S BSDXFDA(2.98,BSDXIENS,14)="" . S BSDXFDA(2.98,BSDXIENS,15)="" K BSDXIEN D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") S BSDXZ=$G(BSDXMSG("DIERR",1,"TEXT",1)) Q ; BSDXNOS(BSDXAPTID,BSDXNS) ; ; N BSDXFDA,BSDXIENS S BSDXIENS=BSDXAPTID_"," S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW D FILE^DIE("","BSDXFDA","BSDXMSG") ; Q ; NOSEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX NOSHOW APPOINTMENT event ;when appointments NOSHOW via PIMS interface. ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients ; Q:+$G(BSDXNOEV) Q:'+$G(BSDXSC) Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK" N BSDXSTAT,BSDXFOUND,BSDXRES S BSDXSTAT=1 S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0 S BSDXFOUND=0 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) I BSDXFOUND D NOSEVT3(BSDXRES) Q I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) I BSDXFOUND D NOSEVT3(BSDXRES) Q ; NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ; ;Get appointment id in BSDXAPT ;If found, call BSDXNOS(BSDXAPPT) and return 1 ;else return 0 N BSDXFOUND,BSDXAPPT S BSDXFOUND=0 Q:'+$G(BSDXRES) BSDXFOUND Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q I BSDXFOUND,+$G(BSDXAPPT) D BSDXNOS(BSDXAPPT,BSDXSTAT) Q BSDXFOUND ; NOSEVT3(BSDXRES) ; ;Call RaiseEvent to notify GUI clients ; N BSDXRESN S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) Q:BSDXRESN="" S BSDXRESN=$P(BSDXRESN,"^") D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) Q ; ; ERR(BSDXERID,ERRTXT) ;Error processing S:'+$G(BSDXI) BSDXI=999999 S BSDXI=BSDXI+1 TROLLBACK S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(31) Q ; ETRAP ;EP Error trap entry D ^%ZTER I '$D(BSDXI) N BSDXI S BSDXI=999999 S BSDXI=BSDXI+1 D ERR(0,"BSDX31 Error: "_$G(%ZTERROR)) Q ; IMHERE(BSDXRES) ;EP ;Entry point for BSDX IM HERE remote procedure S BSDXRES=1 Q ;