source: Scheduling/trunk/m/BSDX31.m@ 755

BSDX31  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
        ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
        ;
        ;
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
        ;