BSDX31.m

BSDX31 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;

 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 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

 ;

BSDX31    ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;

 +1       ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010

 +2       ;

 +3       ;

NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP

 +1       ;Entry point for debugging

 +2       ;

 +3       ;D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)")

 +4        QUIT 

 +5       ;

NOSHOW(BSDXY,BSDXAPTID,BSDXNS) ;EP

 +1       ;Called by BSDX NOSHOW

 +2       ;Sets appointment noshow flag in BSDX APPOINTMENT file

 +3       ;BSDXAPTID is entry number in BSDX APPOINTMENT file

 +4       ;BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO

 +5       ;Calls CANCEL^BSDAPI to set noshow data in ^DPT

 +6       ;Returns error code in recordset field ERRORID

 +7       ;

 +8        NEW BSDXNOD,BSDXPATID,BSDXSTART,BSDXID,BSDXI,BSDXZ,BSDXERR,BSDXMSG,BSDXFDA,BSDXIENS

 +9        NEW BSDXNOEV

 +10      ;Don't execute protocol

           SET BSDXNOEV=1

 +11      ;

 +12       DO ^XBKVAR

           SET X="ETRAP^BSDX31"

           SET @^%ZOSF("TRAP")

 +13       SET BSDXI=0

 +14       KILL ^BSDXTMP($JOB)

 +15       SET BSDXY="^BSDXTMP("_$JOB_")"

 +16       SET ^BSDXTMP($JOB,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$CHAR(30)

 +17       SET BSDXI=BSDXI+1

 +18       TSTART 

 +19       IF '+BSDXAPTID

               DO ERR(0,"BSDX31: Invalid Appointment ID")

               QUIT 

 +20       IF '$DATA(^BSDXAPPT(BSDXAPTID,0))

               DO ERR(0,"BSDX31: Invalid Appointment ID")

               QUIT 

 +21       SET BSDXNS=+BSDXNS

 +22       IF BSDXNS'=1&(BSDXNS'=0)

               DO ERR(0,"BSDX31: Invalid No Show value")

               QUIT 

 +23      ;

 +24      ;Edit BSDX APPOINTMENT entry NOSHOW field

 +25       SET BSDXNOD=^BSDXAPPT(BSDXAPTID,0)

 +26       IF BSDXNOD=""

               DO ERR(0,"BSDX31: Invalid Appointment ID")

               QUIT 

 +27       SET BSDXPATID=$PIECE(BSDXNOD,U,5)

 +28       SET BSDXSTART=$PIECE(BSDXNOD,U)

 +29      ;

 +30       DO BSDXNOS(BSDXAPTID,BSDXNS)

 +31       IF $DATA(BSDXMSG("DIERR"))

               SET BSDXMSG=$GET(BSDXMSG("DIERR",1,"TEXT",1))

               DO ERR(0,"BSDX31: "_BSDXMSG)

               QUIT 

 +32      ;

 +33      ;RESOURCEID

           SET BSDXSC1=$PIECE(BSDXNOD,U,7)

 +34       IF BSDXSC1]""

               IF $DATA(^BSDXRES(BSDXSC1,0))

                   Begin DoDot:1

 +35                   SET BSDXNOD=^BSDXRES(BSDXSC1,0)

 +36      ;HOSPITAL LOCATION

                       SET BSDXSC1=$PIECE(BSDXNOD,U,4)

 +37                   IF BSDXSC1]""

                           IF $DATA(^SC(BSDXSC1,0))

                               DO APNOSHO(.BSDXZ,BSDXSC1,BSDXPATID,BSDXSTART,BSDXNS)

                   End DoDot:1

                   IF $GET(BSDXZ)]""

                       SET BSDXERR="BSDX31: APNOSHO Returned: "_BSDXZ

                       DO ERR(0,BSDXERR)

                       QUIT 

 +38      ;

 +39       TCOMMIT 

 +40       SET BSDXI=BSDXI+1

 +41       SET ^BSDXTMP($JOB,BSDXI)="1^"_$CHAR(30)

 +42       SET BSDXI=BSDXI+1

 +43       SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)

 +44       QUIT 

 +45      ;

APNOSHO(BSDXZ,BSDXSC1,BSDXDFN,BSDXSD,BSDXNS) ;

 +1       ; update file 2 info

 +2       ;Set noshow for patient BSDXDFN in clinic BSDXSC1

 +3       ;at time BSDXSD

 +4        NEW BSDXC,%H,BSDXCDT,BSDXIEN

 +5        NEW BSDXIENS,BSDXFDA,BSDXMSG

 +6        SET %H=$HOROLOG

           DO YMD^%DTC

 +7        SET BSDXCDT=X+%

 +8       ;

 +9        SET BSDXIENS=BSDXSD_","_BSDXDFN_","

 +10       IF +BSDXNS

               Begin DoDot:1

 +11               SET BSDXFDA(2.98,BSDXIENS,3)="N"

 +12               SET BSDXFDA(2.98,BSDXIENS,14)=DUZ

 +13               SET BSDXFDA(2.98,BSDXIENS,15)=BSDXCDT

               End DoDot:1

 +14      IF '$TEST

               Begin DoDot:1

 +15               SET BSDXFDA(2.98,BSDXIENS,3)=""

 +16               SET BSDXFDA(2.98,BSDXIENS,14)=""

 +17               SET BSDXFDA(2.98,BSDXIENS,15)=""

               End DoDot:1

 +18       KILL BSDXIEN

 +19       DO UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")

 +20       SET BSDXZ=$GET(BSDXMSG("DIERR",1,"TEXT",1))

 +21       QUIT 

 +22      ;

BSDXNOS(BSDXAPTID,BSDXNS) ;

 +1       ;

 +2        NEW BSDXFDA,BSDXIENS

 +3        SET BSDXIENS=BSDXAPTID_","

 +4       ;NOSHOW

           SET BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS

 +5        DO FILE^DIE("","BSDXFDA","BSDXMSG")

 +6       ;

 +7        QUIT 

 +8       ;

NOSEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX NOSHOW APPOINTMENT event

 +1       ;when appointments NOSHOW via PIMS interface.

 +2       ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients

 +3       ;

 +4        IF +$GET(BSDXNOEV)

               QUIT 

 +5        IF '+$GET(BSDXSC)

               QUIT 

 +6        IF $GET(SDATA("AFTER","STATUS"))["AUTO RE-BOOK"

               QUIT 

 +7        NEW BSDXSTAT,BSDXFOUND,BSDXRES

 +8        SET BSDXSTAT=1

 +9        IF $GET(SDATA("BEFORE","STATUS"))["NO-SHOW"

               SET BSDXSTAT=0

 +10       SET BSDXFOUND=0

 +11       IF $DATA(^BSDXRES("ALOC",BSDXSC))

               SET BSDXRES=$ORDER(^BSDXRES("ALOC",BSDXSC,0))

               SET BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)

 +12       IF BSDXFOUND

               DO NOSEVT3(BSDXRES)

               QUIT 

 +13       IF $DATA(^BXDXRES("ASSOC",BSDXSC))

               SET BSDXRES=$ORDER(^BSDXRES("ASSOC",BSDXSC,0))

               SET BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)

 +14       IF BSDXFOUND

               DO NOSEVT3(BSDXRES)

 +15       QUIT 

 +16      ;

NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ;

 +1       ;Get appointment id in BSDXAPT

 +2       ;If found, call BSDXNOS(BSDXAPPT) and return 1

 +3       ;else return 0

 +4        NEW BSDXFOUND,BSDXAPPT

 +5        SET BSDXFOUND=0

 +6        IF '+$GET(BSDXRES)

               QUIT BSDXFOUND

 +7        IF '$DATA(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART))

               QUIT BSDXFOUND

 +8        SET BSDXAPPT=0

           FOR 

               SET BSDXAPPT=$ORDER(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT))

               IF '+BSDXAPPT

                   QUIT 

               Begin DoDot:1

 +9                SET BSDXNOD=$GET(^BSDXAPPT(BSDXAPPT,0))

                   IF BSDXNOD=""

                       QUIT 

 +10               IF $PIECE(BSDXNOD,U,5)=BSDXPAT

                       IF $PIECE(BSDXNOD,U,12)=""

                           SET BSDXFOUND=1

                           QUIT 

               End DoDot:1

               IF BSDXFOUND

                   QUIT 

 +11       IF BSDXFOUND

               IF +$GET(BSDXAPPT)

                   DO BSDXNOS(BSDXAPPT,BSDXSTAT)

 +12       QUIT BSDXFOUND

 +13      ;

NOSEVT3(BSDXRES) ;

 +1       ;Call RaiseEvent to notify GUI clients

 +2       ;

 +3        NEW BSDXRESN

 +4        SET BSDXRESN=$GET(^BSDXRES(BSDXRES,0))

 +5        IF BSDXRESN=""

               QUIT 

 +6        SET BSDXRESN=$PIECE(BSDXRESN,"^")

 +7        DO EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)

 +8        QUIT 

 +9       ;

 +10      ;

ERR(BSDXERID,ERRTXT) ;Error processing

 +1        IF '+$GET(BSDXI)

               SET BSDXI=999999

 +2        SET BSDXI=BSDXI+1

 +3        TROLLBACK 

 +4        SET ^BSDXTMP($JOB,BSDXI)=BSDXERID_"^"_ERRTXT_$CHAR(30)

 +5        SET BSDXI=BSDXI+1

 +6        SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)

 +7        QUIT 

 +8       ;

ETRAP     ;EP Error trap entry

 +1        DO ^%ZTER

 +2        IF '$DATA(BSDXI)

               NEW BSDXI

               SET BSDXI=999999

 +3        SET BSDXI=BSDXI+1

 +4        DO ERR(0,"BSDX31 Error: "_$GET(%ZTERROR))

 +5        QUIT 

 +6       ;

IMHERE(BSDXRES) ;EP

 +1       ;Entry point for BSDX IM HERE remote procedure

 +2        SET BSDXRES=1

 +3        QUIT 

 +4       ;