Bumped version up to 1.41

This commit is contained in:
sam 2010-09-29 07:48:57 +00:00
parent 223b2feef4
commit 01e023ad19
37 changed files with 357 additions and 357 deletions

View File

@ -1,5 +1,5 @@
BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/29/10 10:20am BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/29/10 10:20am
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
SUINFOD(BSDXY,BSDXDUZ) ;EP Debugging entry point SUINFOD(BSDXY,BSDXDUZ) ;EP Debugging entry point
;D DEBUG^%Serenji("SUINFO^BSDX01(.BSDXY,BSDXDUZ)") ;D DEBUG^%Serenji("SUINFO^BSDX01(.BSDXY,BSDXDUZ)")
@ -37,7 +37,7 @@ DEPUSR(BSDXY,BSDXDUZ) ;EP
;Returns ADO Recordset with all ACTIVE resource group names to which user has access ;Returns ADO Recordset with all ACTIVE resource group names to which user has access
;based on entries in BSDX RESOURCE USER file (Say this again for myself: Groups ONLY!!) ;based on entries in BSDX RESOURCE USER file (Say this again for myself: Groups ONLY!!)
;If BSDXDUZ=0 then returns all department names for current DUZ ;If BSDXDUZ=0 then returns all department names for current DUZ
;if not linked, always returned. ;if not linked, always returned.
;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE ;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE
;then ALL resource group names are returned regardless of whether any active resources ;then ALL resource group names are returned regardless of whether any active resources
;are associated with the group or not. ;are associated with the group or not.
@ -60,7 +60,7 @@ DEPUSR(BSDXY,BSDXDUZ) ;EP
I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
. S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U) . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
. Q:'$D(^BSDXDEPT("AB",BSDXRES)) ; If not part of a group, quit ("AB" is the whole file index for the resource multiple in Group file) . Q:'$D(^BSDXDEPT("AB",BSDXRES)) ; If not part of a group, quit ("AB" is the whole file index for the resource multiple in Group file)
. ; Q:'$$INDIV2(BSDXRES) ; If not in the same division as user, quit . ; Q:'$$INDIV2(BSDXRES) ; If not in the same division as user, quit
. S BSDXRNOD=^BSDXRES(BSDXRES,0) . S BSDXRNOD=^BSDXRES(BSDXRES,0)
. ;QUIT if the resource is inactive . ;QUIT if the resource is inactive
. Q:$P(BSDXRNOD,U,2)=1 . Q:$P(BSDXRNOD,U,2)=1
@ -119,10 +119,10 @@ RESUSR(BSDXY,BSDXDUZ) ;EP
. Q:'$D(^BSDXRES(BSDXRES,0)) . Q:'$D(^BSDXRES(BSDXRES,0))
. S BSDXRNOD=^BSDXRES(BSDXRES,0) . S BSDXRNOD=^BSDXRES(BSDXRES,0)
. N BSDXSC S BSDXSC=$P(BSDXRNOD,U,4) ; Hospital Location . N BSDXSC S BSDXSC=$P(BSDXRNOD,U,4) ; Hospital Location
. ;Q:$P(BSDXRNOD,U,2)=1 ;Inactive resources not filtered . ;Q:$P(BSDXRNOD,U,2)=1 ;Inactive resources not filtered
. ;S BSDXRDAT=$P(BSDXRNOD,U,1,4) . ;S BSDXRDAT=$P(BSDXRNOD,U,1,4)
. ;I '$$INDIV(BSDXSC) QUIT ; If not in division, quit . ;I '$$INDIV(BSDXSC) QUIT ; If not in division, quit
. K BSDXRDAT . K BSDXRDAT
. F BSDX=1:1:4 S $P(BSDXRDAT,U,BSDX)=$P(BSDXRNOD,U,BSDX) . F BSDX=1:1:4 S $P(BSDXRDAT,U,BSDX)=$P(BSDXRNOD,U,BSDX)
. S BSDXRDAT=BSDXRES_U_BSDXRDAT . S BSDXRDAT=BSDXRES_U_BSDXRDAT
. ;Get letter text from wp field . ;Get letter text from wp field
@ -197,7 +197,7 @@ DEPRES(BSDXY,BSDXDUZ) ;EP
I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
. S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U) . S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
. Q:'$D(^BSDXDEPT("AB",BSDXRES)) ; Quit if Resource isn't part of any Group . Q:'$D(^BSDXDEPT("AB",BSDXRES)) ; Quit if Resource isn't part of any Group
. ;Q:'$$INDIV2(BSDXRES) ; Quit if Resource isn't in same division as user. . ;Q:'$$INDIV2(BSDXRES) ; Quit if Resource isn't in same division as user.
. S BSDXRNOD=$G(^BSDXRES(BSDXRES,0)) . S BSDXRNOD=$G(^BSDXRES(BSDXRES,0))
. Q:BSDXRNOD="" . Q:BSDXRNOD=""
. ;QUIT if the resource is inactive . ;QUIT if the resource is inactive
@ -222,7 +222,7 @@ DEPRES(BSDXY,BSDXDUZ) ;EP
. . Q:'$D(^BSDXDEPT(BSDXIEN,1,BSDXRES,0)) ; Quit if zero node is invalid in multiple . . Q:'$D(^BSDXDEPT(BSDXIEN,1,BSDXRES,0)) ; Quit if zero node is invalid in multiple
. . S BSDXRESD=$P(^BSDXDEPT(BSDXIEN,1,BSDXRES,0),"^") . . S BSDXRESD=$P(^BSDXDEPT(BSDXIEN,1,BSDXRES,0),"^")
. . Q:'$D(^BSDXRES(BSDXRESD,0)) ; Quit if zero node of resouce file is invalid . . Q:'$D(^BSDXRES(BSDXRESD,0)) ; Quit if zero node of resouce file is invalid
. . ;Q:'$$INDIV2(BSDXRESD) ; Quit if resource is not in the same division . . ;Q:'$$INDIV2(BSDXRESD) ; Quit if resource is not in the same division
. . S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0)) . . S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
. . Q:BSDXRNOD="" . . Q:BSDXRNOD=""
. . ;QUIT if the resource is inactive . . ;QUIT if the resource is inactive
@ -256,41 +256,41 @@ APSEC(BSDXKEY,BSDXDUZ) ;EP - Return TRUE (1) if user has keys BSDXKEY or XUPROGM
I '+BSDXIEN Q 0 I '+BSDXIEN Q 0
I '$D(^VA(200,BSDXDUZ,51,BSDXIEN,0)) Q 0 I '$D(^VA(200,BSDXDUZ,51,BSDXIEN,0)) Q 0
Q 1 Q 1
INDIV(BSDXSC) ; PEP - Is ^SC clinic in the same DUZ(2) as user? INDIV(BSDXSC) ; PEP - Is ^SC clinic in the same DUZ(2) as user?
; Input: BSDXSC - Hospital Location IEN ; Input: BSDXSC - Hospital Location IEN
; Output: True or False ; Output: True or False
I '+BSDXSC QUIT 1 ;If not tied to clinic, yes I '+BSDXSC QUIT 1 ;If not tied to clinic, yes
I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes
; Jump to Division:Medical Center Division:Inst File Pointer for ; Jump to Division:Medical Center Division:Inst File Pointer for
; Institution IEN (and get its internal value) ; Institution IEN (and get its internal value)
N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I") N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I")
I DIV="" Q 1 ; If clinic has no division, consider it avial to user. I DIV="" Q 1 ; If clinic has no division, consider it avial to user.
I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic
E Q 0 ; Otherwise, no E Q 0 ; Otherwise, no
QUIT QUIT
INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user? INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user?
; Input BSDXRES - BSDX RESOURCE IEN ; Input BSDXRES - BSDX RESOURCE IEN
; Output: True of False ; Output: True of False
Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV
UnitTestINDIV UnitTestINDIV
W "Testing if they are the same",! W "Testing if they are the same",!
S DUZ(2)=67 S DUZ(2)=67
I '$$INDIV(1) W "ERROR",! I '$$INDIV(1) W "ERROR",!
I '$$INDIV(2) W "ERROR",! I '$$INDIV(2) W "ERROR",!
W "Testing if Div not defined in 44, should be true",! W "Testing if Div not defined in 44, should be true",!
I '$$INDIV(3) W "ERROR",! I '$$INDIV(3) W "ERROR",!
W "Testing empty string. Should be true",! W "Testing empty string. Should be true",!
I '$$INDIV("") W "ERROR",! I '$$INDIV("") W "ERROR",!
W "Testing if they are different",! W "Testing if they are different",!
S DUZ(2)=899 S DUZ(2)=899
I $$INDIV(1) W "ERROR",! I $$INDIV(1) W "ERROR",!
I $$INDIV(2) W "ERROR",! I $$INDIV(2) W "ERROR",!
QUIT QUIT
UnitTestINDIV2 UnitTestINDIV2
W "Testing if they are the same",! W "Testing if they are the same",!
S DUZ(2)=69 S DUZ(2)=69
I $$INDIV2(22)'=0 W "ERROR",! I $$INDIV2(22)'=0 W "ERROR",!
I $$INDIV2(25)'=1 W "ERROR",! I $$INDIV2(25)'=1 W "ERROR",!
I $$INDIV2(26)'=1 W "ERROR",! I $$INDIV2(26)'=1 W "ERROR",!
I $$INDIV2(27)'=1 W "ERROR",! I $$INDIV2(27)'=1 W "ERROR",!
QUIT QUIT

View File

@ -1,5 +1,5 @@
BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:25pm BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:25pm
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; Change Log ; Change Log
; July 15 2010: UJO/SMH - Pass FM dates in instead of US dates for i18n ; July 15 2010: UJO/SMH - Pass FM dates in instead of US dates for i18n

View File

@ -1,5 +1,5 @@
BSDX03 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; BSDX03 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
Q Q

View File

@ -1,5 +1,5 @@
BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/15/10 12:44pm BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/15/10 12:44pm
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; Change Log: ; Change Log:
; July 11 2010: Pass BSDXSTART and END as FM dates rather than US formatted dates ; July 11 2010: Pass BSDXSTART and END as FM dates rather than US formatted dates
; for i18n ; for i18n

View File

@ -1,5 +1,5 @@
BSDX05 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:51pm BSDX05 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:51pm
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; Change Log: ; Change Log:
; UJO/SMH - July 11 2010: pass FM Dates for Start and End rather than US Dates ; UJO/SMH - July 11 2010: pass FM Dates for Start and End rather than US Dates

View File

@ -1,5 +1,5 @@
BSDX06 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 4:51pm BSDX06 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 4:51pm
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; Change Log: ; Change Log:
; UJO/SMH: July 15 2010: Change in BSDXSTART and BSDXEND: get ; UJO/SMH: July 15 2010: Change in BSDXSTART and BSDXEND: get
; dates in FM format for i18n ; dates in FM format for i18n

View File

@ -1,5 +1,5 @@
BSDX07 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/18/10 2:11pm BSDX07 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/18/10 2:11pm
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; Change Log: ; Change Log:
; UJO/SMH ; UJO/SMH

View File

@ -1,5 +1,5 @@
BSDX08 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/15/10 8:21pm BSDX08 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/15/10 8:21pm
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
APPDELD(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP APPDELD(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP

View File

@ -1,5 +1,5 @@
BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 8/16/10 4:28pm BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 8/16/10 4:28pm
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; Change Log: ; Change Log:
; UJO/TH - v 1.3 on 3100714 - Extra Demographics: ; UJO/TH - v 1.3 on 3100714 - Extra Demographics:

View File

@ -1,5 +1,5 @@
BSDX11 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; BSDX11 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
ENV0100 ;EP Version 1.0 Environment check ENV0100 ;EP Version 1.0 Environment check
I '$G(IOM) D HOME^%ZIS I '$G(IOM) D HOME^%ZIS

View File

@ -1,5 +1,5 @@
BSDX12 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:14pm BSDX12 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:14pm
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; Change Log: ; Change Log:
; v 1.3 - i18n support - 3100718 ; v 1.3 - i18n support - 3100718

View File

@ -1,5 +1,5 @@
BSDX13 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:17pm BSDX13 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:17pm
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; Change Log: ; Change Log:
; V 1.3 - i18n support - Dates passed to Routine as FM Date - WV/SMH ; V 1.3 - i18n support - Dates passed to Routine as FM Date - WV/SMH

View File

@ -1,5 +1,5 @@
BSDX14 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; BSDX14 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
ACCTYPD(BSDXY,BSDXVAL) ;EP ACCTYPD(BSDXY,BSDXVAL) ;EP

View File

@ -1,5 +1,5 @@
BSDX15 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; BSDX15 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
GRPTYP(BSDXY) ;EP GRPTYP(BSDXY) ;EP

View File

@ -1,5 +1,5 @@
BSDX16 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; BSDX16 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
RSRCD(BSDXY,BSDXVAL) ;EP RSRCD(BSDXY,BSDXVAL) ;EP

View File

@ -1,5 +1,5 @@
BSDX17 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; BSDX17 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
SCHUSRD(BSDXY) ;EP SCHUSRD(BSDXY) ;EP

View File

@ -1,5 +1,5 @@
BSDX18 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; BSDX18 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
DELRUD(BSDXY,BSDXIEN) ;EP DELRUD(BSDXY,BSDXIEN) ;EP

View File

@ -1,5 +1,5 @@
BSDX19 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; BSDX19 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
ADDRGD(BSDXY,BSDXVAL) ;EP ADDRGD(BSDXY,BSDXVAL) ;EP

View File

@ -1,5 +1,5 @@
BSDX20 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; BSDX20 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
DELRGID(BSDXY,BSDXIEN) ;EP DELRGID(BSDXY,BSDXIEN) ;EP

View File

@ -1,5 +1,5 @@
BSDX21 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/21/10 9:42pm BSDX21 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/21/10 9:42pm
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
ADDAGD(BSDXY,BSDXVAL) ;EP ADDAGD(BSDXY,BSDXVAL) ;EP

View File

@ -1,5 +1,5 @@
BSDX22 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; BSDX22 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
DELAGID(BSDXY,BSDXIEN,BSDXIEN1) ;EP DELAGID(BSDXY,BSDXIEN,BSDXIEN1) ;EP

View File

@ -1,5 +1,5 @@
BSDX23 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; BSDX23 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
EVENT(BSDXEVENT,BSDXPARAM,BSDXSIP,BSDXSPT) ;EP EVENT(BSDXEVENT,BSDXPARAM,BSDXSIP,BSDXSPT) ;EP

View File

@ -1,5 +1,5 @@
BSDX24 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; BSDX24 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
Q Q

View File

@ -1,5 +1,5 @@
BSDX25 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; BSDX25 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
CHECKIND(BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP CHECKIND(BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP

View File

@ -1,5 +1,5 @@
BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE) ;EP EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE) ;EP

View File

@ -1,5 +1,5 @@
BSDX27 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:22pm BSDX27 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:22pm
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; Change Log: July 15, 2010 ; Change Log: July 15, 2010
; UJO/SMH - i18n: FM Dates passed into routine for Clinic Letters - CLDISP tag ; UJO/SMH - i18n: FM Dates passed into routine for Clinic Letters - CLDISP tag

View File

@ -1,5 +1,5 @@
BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:30pm BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:30pm
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; Change Log: ; Change Log:
; HMW 3050721 Added test for inactivated record ; HMW 3050721 Added test for inactivated record

View File

@ -1,5 +1,5 @@
BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:03pm BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:03pm
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; Change Log: ; Change Log:
; v1.3 by WV/SMH on 3100713 ; v1.3 by WV/SMH on 3100713

View File

@ -1,5 +1,5 @@
BSDX2E ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [7/18/10 4:30pm] BSDX2E ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [7/18/10 4:30pm]
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
S LINE="",$P(LINE,"*",81)="" S LINE="",$P(LINE,"*",81)=""
S XPDNOQUE="NO QUE" ;NO QUEUING ALLOWED S XPDNOQUE="NO QUE" ;NO QUEUING ALLOWED

View File

@ -1,5 +1,5 @@
BSDX30 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [ 09/12/2007 1:54 PM ] BSDX30 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [ 09/12/2007 1:54 PM ]
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
SPACED(BSDXY,BSDXDIC,BSDXVAL) ;EP SPACED(BSDXY,BSDXDIC,BSDXVAL) ;EP

View File

@ -1,5 +1,5 @@
BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP

View File

@ -1,5 +1,5 @@
BSDX32 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/29/10 10:21am BSDX32 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/29/10 10:21am
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
ERROR ; ERROR ;
@ -19,7 +19,7 @@ HOSPLOCD(BSDXY) ;EP Debugging entry point
; ;
HOSPLOC(BSDXY) ;EP HOSPLOC(BSDXY) ;EP
;Called by BSDX HOSPITAL LOCATION ;Called by BSDX HOSPITAL LOCATION
;Returns all hospital locations that are active ;Returns all hospital locations that are active
; ;
N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXINA,BSDXREA,BSDXSCOD N BSDXI,BSDXIEN,BSDXNOD,BSDXNAM,BSDXINA,BSDXREA,BSDXSCOD
D ^XBKVAR S X="ERROR^BSDX32",@^%ZOSF("TRAP") D ^XBKVAR S X="ERROR^BSDX32",@^%ZOSF("TRAP")
@ -33,7 +33,7 @@ HOSPLOC(BSDXY) ;EP
. S BSDXIEN=$O(^SC("B",BSDXNAM,0)) . S BSDXIEN=$O(^SC("B",BSDXNAM,0))
. Q:'+BSDXIEN>0 . Q:'+BSDXIEN>0
. Q:'$D(^SC(+BSDXIEN,0)) . Q:'$D(^SC(+BSDXIEN,0))
. ;Q:'$$INDIV^BSDX01(+BSDXIEN) ; if not in the same division, quit . ;Q:'$$INDIV^BSDX01(+BSDXIEN) ; if not in the same division, quit
. S BSDXINA=$$GET1^DIQ(44,BSDXIEN_",",2505) ;INACTIVATE . S BSDXINA=$$GET1^DIQ(44,BSDXIEN_",",2505) ;INACTIVATE
. S BSDXREA=$$GET1^DIQ(44,BSDXIEN_",",2506) ;REACTIVATE . S BSDXREA=$$GET1^DIQ(44,BSDXIEN_",",2506) ;REACTIVATE
. I BSDXINA]""&(BSDXREA="") Q ;Clinic is inactivated and has no reactivate date . I BSDXINA]""&(BSDXREA="") Q ;Clinic is inactivated and has no reactivate date

View File

@ -1,5 +1,5 @@
BSDX33 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:33pm BSDX33 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:33pm
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; Mods by WV/STAR ; Mods by WV/STAR
; ;
; Change Log: ; Change Log:

View File

@ -1,5 +1,5 @@
BSDX34 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:37pm BSDX34 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:37pm
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; Change Log: ; Change Log:
; July 10 2010: ; July 10 2010:

View File

@ -1,5 +1,5 @@
BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
Q Q

View File

@ -1,275 +1,275 @@
BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 9/28/10 12:36pm BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 9/28/10 12:36pm
;;1.4;BSDX;;Sep 07, 2010;Build 7 ;;1.41;BSDX;;Sep 29, 2010;Build 7
;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
;local mods (many) by WV/SMH ;local mods (many) by WV/SMH
;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
; Change History: ; Change History:
; - Fixed errors having to do uncanceling patient appointments if it was a patient cancelled appointment. ; - Fixed errors having to do uncanceling patient appointments if it was a patient cancelled appointment.
; - Use new style Fileman API for storing appointments in file 44 in $$MAKE due to problems with legacy API. ; - Use new style Fileman API for storing appointments in file 44 in $$MAKE due to problems with legacy API.
; ;
MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment
; Call like this for DFN 23435 having an appointment at Hospital Location 33 ; Call like this for DFN 23435 having an appointment at Hospital Location 33
; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
; for Baby foxes hallucinations. ; for Baby foxes hallucinations.
; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes") ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
S BSDR("PAT")=DFN ;DFN S BSDR("PAT")=DFN ;DFN
S BSDR("CLN")=CLIN ;Hosp Loc IEN S BSDR("CLN")=CLIN ;Hosp Loc IEN
S BSDR("TYP")=TYP ;3 sched or 4 walkin S BSDR("TYP")=TYP ;3 sched or 4 walkin
S BSDR("ADT")=DATE ;Appointment date in FM format S BSDR("ADT")=DATE ;Appointment date in FM format
S BSDR("LEN")=LEN ;Appt len upto 240 (min) S BSDR("LEN")=LEN ;Appt len upto 240 (min)
S BSDR("INFO")=INFO ;Reason for appt - up to 150 char S BSDR("INFO")=INFO ;Reason for appt - up to 150 char
S BSDR("USR")=DUZ ;Person who made appt - current user S BSDR("USR")=DUZ ;Person who made appt - current user
Q $$MAKE(.BSDR) Q $$MAKE(.BSDR)
; ;
MAKE(BSDR) ;PEP; call to store appt made MAKE(BSDR) ;PEP; call to store appt made
; ;
; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY) ; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY)
; ;
; Input Array - ; Input Array -
; BSDR("PAT") = ien of patient in file 2 ; BSDR("PAT") = ien of patient in file 2
; BSDR("CLN") = ien of clinic in file 44 ; BSDR("CLN") = ien of clinic in file 44
; BSDR("TYP") = 3 for scheduled appts, 4 for walkins ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins
; BSDR("ADT") = appointment date and time ; BSDR("ADT") = appointment date and time
; BSDR("LEN") = appointment length in minutes (5-120) ; BSDR("LEN") = appointment length in minutes (5-120)
; BSDR("OI") = reason for appt - up to 150 characters ; BSDR("OI") = reason for appt - up to 150 characters
; BSDR("USR") = user who made appt ; BSDR("USR") = user who made appt
; ;
;Output: error status and message ;Output: error status and message
; = 0 or null: everything okay ; = 0 or null: everything okay
; = 1^message: error and reason ; = 1^message: error and reason
; ;
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP")) I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
; ;
I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN"))
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT") I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT")
; ;
NEW DIC,DA,Y,X,DD,DO,DLAYGO NEW DIC,DA,Y,X,DD,DO,DLAYGO
; ;
I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D
. ; "un-cancel" existing appt in file 2 . ; "un-cancel" existing appt in file 2
. N BSDXFDA,BSDXIENS,BSDXMSG . N BSDXFDA,BSDXIENS,BSDXMSG
. S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_"," . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
. S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN") . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
. S BSDXFDA(2.98,BSDXIENS,"3")="" . S BSDXFDA(2.98,BSDXIENS,"3")=""
. S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
. S BSDXFDA(2.98,BSDXIENS,"9.5")=9 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
. S BSDXFDA(2.98,BSDXIENS,"14")="" . S BSDXFDA(2.98,BSDXIENS,"14")=""
. S BSDXFDA(2.98,BSDXIENS,"15")="" . S BSDXFDA(2.98,BSDXIENS,"15")=""
. S BSDXFDA(2.98,BSDXIENS,"16")="" . S BSDXFDA(2.98,BSDXIENS,"16")=""
. S BSDXFDA(2.98,BSDXIENS,"19")="" . S BSDXFDA(2.98,BSDXIENS,"19")=""
. S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
. D FILE^DIE("","BSDXFDA","BSDXMSG") . D FILE^DIE("","BSDXFDA","BSDXMSG")
. N BSDXTEMP S BSDXTEMP=$G(BSDXMSG) . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)
E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")
. N BSDXFDA,BSDXIENS,BSDXMSG . N BSDXFDA,BSDXIENS,BSDXMSG
. S BSDXIENS="?+2,"_BSDR("PAT")_"," . S BSDXIENS="?+2,"_BSDR("PAT")_","
. S BSDXIENS(2)=BSDR("ADT") . S BSDXIENS(2)=BSDR("ADT")
. S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN") . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
. S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
. S BSDXFDA(2.98,BSDXIENS,"9.5")=9 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
. S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
. D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)") . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
; add appt to file 44 ; add appt to file 44
K DIC,DA,X,Y,DLAYGO,DD,DO K DIC,DA,X,Y,DLAYGO,DD,DO
I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^" I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT") I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")
. S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT") . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
. S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001 . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
. S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
; ;
; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh ; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh
;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM ;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," ;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT") ;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")
;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".") ;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".")
;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003 ;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
;D FILE^DICN ;D FILE^DICN
; ;
N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_"," N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_","
N BSDXFDA N BSDXFDA
S BSDXFDA(44.003,BSDXIENS,.01)=BSDR("PAT") S BSDXFDA(44.003,BSDXIENS,.01)=BSDR("PAT")
S BSDXFDA(44.003,BSDXIENS,1)=BSDR("LEN") S BSDXFDA(44.003,BSDXIENS,1)=BSDR("LEN")
S BSDXFDA(44.003,BSDXIENS,3)=$E($G(BSDR("OI")),1,150) S BSDXFDA(44.003,BSDXIENS,3)=$E($G(BSDR("OI")),1,150)
S BSDXFDA(44.003,BSDXIENS,7)=BSDR("USR") S BSDXFDA(44.003,BSDXIENS,7)=BSDR("USR")
S BSDXFDA(44.003,BSDXIENS,8)=$P($$NOW^XLFDT,".") S BSDXFDA(44.003,BSDXIENS,8)=$P($$NOW^XLFDT,".")
N BSDXERR N BSDXERR
D UPDATE^DIE("","BSDXFDA","","BSDXERR") D UPDATE^DIE("","BSDXFDA","","BSDXERR")
; ;
I $D(BSDXERR) Q 1_U_"Error adding appt to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")_" Patient="_BSDR("PAT")_" Error: "_BSDXERR("DIERR",1,"TEXT",1) I $D(BSDXERR) Q 1_U_"Error adding appt to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")_" Patient="_BSDR("PAT")_" Error: "_BSDXERR("DIERR",1,"TEXT",1)
; ;
; call event driver ; call event driver
NEW DFN,SDT,SDCL,SDDA,SDMODE NEW DFN,SDT,SDCL,SDDA,SDMODE
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE) D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
Q 0 Q 0
; ;
CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
; Call like this for DFN 23435 checking in now at Hospital Location 33 ; Call like this for DFN 23435 checking in now at Hospital Location 33
; for appt at Dec 20, 2009 @ 10:11:59 ; for appt at Dec 20, 2009 @ 10:11:59
; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159) ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
S BSDR("PAT")=DFN ;DFN S BSDR("PAT")=DFN ;DFN
S BSDR("CLN")=CLIN ;Hosp Loc IEN S BSDR("CLN")=CLIN ;Hosp Loc IEN
S BSDR("ADT")=APDATE ;Appt Date S BSDR("ADT")=APDATE ;Appt Date
S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now
S BSDR("USR")=DUZ ;Check-in user defaults to current S BSDR("USR")=DUZ ;Check-in user defaults to current
Q $$CHECKIN(.BSDR) Q $$CHECKIN(.BSDR)
; ;
CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002 CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002
; ;
; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY) ; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY)
; ;
; Input array - ; Input array -
; BSDR("PAT") = ien of patient in file 2 ; BSDR("PAT") = ien of patient in file 2
; BSDR("CLN") = ien of clinic in file 44 ; BSDR("CLN") = ien of clinic in file 44
; BSDR("ADT") = appt date/time ; BSDR("ADT") = appt date/time
; BSDR("CDT") = checkin date/time ; BSDR("CDT") = checkin date/time
; BSDR("USR") = checkin user ; BSDR("USR") = checkin user
; ;
; Output value - ; Output value -
; = 0 means everything worked ; = 0 means everything worked
; = 1^message means error with reason message ; = 1^message means error with reason message
; ;
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT")) I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
; ;
; find ien for appt in file 44 ; find ien for appt in file 44
NEW IEN,DIE,DA,DR NEW IEN,DIE,DA,DR
S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
; ;
; remember before status ; remember before status
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
; ;
; set checkin ; set checkin
S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
D ^DIE D ^DIE
; ;
; set after status ; set after status
S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
; ;
; call event driver ; call event driver
D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL) D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
Q 0 Q 0
; ;
CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment
; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33, ; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33,
; cancellation initiated by patient ("PC" rather than clinic "C"), ; cancellation initiated by patient ("PC" rather than clinic "C"),
; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather) ; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)
; because foxes come out during bad weather. ; because foxes come out during bad weather.
; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes") ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
S BSDR("PAT")=DFN S BSDR("PAT")=DFN
S BSDR("CLN")=CLIN S BSDR("CLN")=CLIN
S BSDR("TYP")=TYP S BSDR("TYP")=TYP
S BSDR("ADT")=APDATE S BSDR("ADT")=APDATE
S BSDR("CDT")=$$NOW^XLFDT S BSDR("CDT")=$$NOW^XLFDT
S BSDR("USR")=DUZ S BSDR("USR")=DUZ
S BSDR("CR")=REASON S BSDR("CR")=REASON
S BSDR("NOT")=INFO S BSDR("NOT")=INFO
Q $$CANCEL(.BSDR) Q $$CANCEL(.BSDR)
; ;
CANCEL(BSDR) ;PEP; called to cancel appt CANCEL(BSDR) ;PEP; called to cancel appt
; ;
; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY) ; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY)
; ;
; Input Array - ; Input Array -
; BSDR("PAT") = ien of patient in file 2 ; BSDR("PAT") = ien of patient in file 2
; BSDR("CLN") = ien of clinic in file 44 ; BSDR("CLN") = ien of clinic in file 44
; BSDR("TYP") = C for canceled by clinic; PC for patient canceled ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
; BSDR("ADT") = appointment date and time ; BSDR("ADT") = appointment date and time
; BSDR("CDT") = cancel date and time ; BSDR("CDT") = cancel date and time
; BSDR("USR") = user who canceled appt ; BSDR("USR") = user who canceled appt
; BSDR("CR") = cancel reason - pointer to file 409.2 ; BSDR("CR") = cancel reason - pointer to file 409.2
; BSDR("NOT") = cancel remarks - optional notes to 160 characters ; BSDR("NOT") = cancel remarks - optional notes to 160 characters
; ;
;Output: error status and message ;Output: error status and message
; = 0 or null: everything okay ; = 0 or null: everything okay
; = 1^message: error and reason ; = 1^message: error and reason
; ;
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP")) I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT")) I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR")) I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR")) I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
; ;
NEW IEN,DIE,DA,DR NEW IEN,DIE,DA,DR
S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
; ;
I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
; ;
; remember before status ; remember before status
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
; ;
; get user who made appt and date appt made from ^SC ; get user who made appt and date appt made from ^SC
; because data in ^SC will be deleted ; because data in ^SC will be deleted
NEW USER,DATE NEW USER,DATE
S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6) S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7) S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
; ;
; update file 2 info ; update file 2 info
NEW DIE,DA,DR NEW DIE,DA,DR
S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160) S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
D ^DIE D ^DIE
; ;
; delete data in ^SC ; delete data in ^SC
NEW DIK,DA NEW DIK,DA
S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
D ^DIK D ^DIK
; ;
; call event driver ; call event driver
D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
Q 0 Q 0
; ;
CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
NEW X NEW X
S X=$G(SDIEN) ;ien sent in call S X=$G(SDIEN) ;ien sent in call
I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U) S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
Q $S(X:1,1:0) Q $S(X:1,1:0)
; ;
SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
NEW X,IEN NEW X,IEN
S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D
. Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)="C" ;cancelled . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)="C" ;cancelled
. I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
Q $G(IEN) Q $G(IEN)
; ;
APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in) APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)
NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7) NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??") Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
; ;
CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
NEW X NEW X
S X=$G(SDIEN) ;ien sent in call S X=$G(SDIEN) ;ien sent in call
I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3) S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
Q $S(X:1,1:0) Q $S(X:1,1:0)
; ;

View File

@ -1,5 +1,5 @@
BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 9/7/10 7:59am BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 9/7/10 7:59am
;;1.4;BSDX;;Sep 07, 2010 ;;1.41;BSDX;;Sep 29, 2010
; ;
; ;
ERROR ; ERROR ;