| 1 | BSDX33 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:33pm
|
|---|
| 2 | ;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
|
|---|
| 3 | ; Mods by WV/STAR
|
|---|
| 4 | ;
|
|---|
| 5 | ; Change Log:
|
|---|
| 6 | ; July 13, 2010
|
|---|
| 7 | ; v 1.3 adds fixes Rebooking behavior in application (see RBNEXT)
|
|---|
| 8 | ; also adds i18 support - Dates passed in FM format from application
|
|---|
| 9 | ; in tag SETRBK and RBNEXT
|
|---|
| 10 | ;
|
|---|
| 11 | ;
|
|---|
| 12 | Q
|
|---|
| 13 | RBNEXTD(BSDXY,BSDXDATE,BSDXRES,BSDXTPID) ;EP
|
|---|
| 14 | ;Entry point for debugging
|
|---|
| 15 | ;
|
|---|
| 16 | ;D DEBUG^%Serenji("RBNEXT^BSDX33(.BSDXY,BSDXDATE,BSDXRES,BSDXTPID)")
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | RBNEXT(BSDXY,BSDXDATE,BSDXRES,BSDXTPID) ;EP
|
|---|
| 20 | ;Called by BSDX REBOOK NEXT BLOCK to find
|
|---|
| 21 | ;the next ACCESS BLOCK in resource BSDXRES after BSDXDATE
|
|---|
| 22 | ;Returns 1 in ERRORID and date in NEXTBLOCK if a block was found or NULL in NEXTBLOCK of no date found
|
|---|
| 23 | ;Otherwise, returns 0 and error message in ERRORTEXT
|
|---|
| 24 | ;If BSDXTPID = 0 then any access type match
|
|---|
| 25 | ;
|
|---|
| 26 | S X="ERROR2^BSDX33",@^%ZOSF("TRAP")
|
|---|
| 27 | N BSDXI,BSDXIENS,%DT,BSDXMSG,Y,BSDXRESD,BSDXFND,BSDXIEN,BSDXNOD,BSDXATID
|
|---|
| 28 | S BSDXY="^BSDXTMP("_$J_")"
|
|---|
| 29 | S BSDXI=0
|
|---|
| 30 | S ^BSDXTMP($J,BSDXI)="I00020ERRORID^D00010NEXTBLOCK^T00030ERRORTEXT"_$C(30)
|
|---|
| 31 | ;
|
|---|
| 32 | I BSDXRES="" D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q
|
|---|
| 33 | I '$D(^BSDXRES("B",BSDXRES)) D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q
|
|---|
| 34 | S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))
|
|---|
| 35 | I '+BSDXRESD D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q
|
|---|
| 36 | ;
|
|---|
| 37 | ; i18n fix
|
|---|
| 38 | ; S X=BSDXDATE,%DT="XT" D ^%DT
|
|---|
| 39 | ; I Y=-1 D ERR2(1,"BSDX REBOOK NEXT BLOCK: Invalid datetime") Q
|
|---|
| 40 | ;
|
|---|
| 41 | ; S BSDXDATE=$P(Y,".")
|
|---|
| 42 | ;
|
|---|
| 43 | S BSDXFND=0
|
|---|
| 44 | F S BSDXDATE=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXDATE)) Q:'+BSDXDATE D Q:BSDXFND
|
|---|
| 45 | . S BSDXIEN=0 F S BSDXIEN=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXDATE,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND
|
|---|
| 46 | . . Q:'$D(^BSDXAB(BSDXIEN,0))
|
|---|
| 47 | . . S BSDXNOD=^BSDXAB(BSDXIEN,0)
|
|---|
| 48 | . . Q:+$P(BSDXNOD,U,4)=0 ;Slots
|
|---|
| 49 | . . S BSDXATID=$P(BSDXNOD,U,5)
|
|---|
| 50 | . . I BSDXTPID=0!(BSDXATID=BSDXTPID) S BSDXFND=$P(BSDXNOD,U,2) Q
|
|---|
| 51 | ;
|
|---|
| 52 | I BSDXFND=0 S BSDXFND=""
|
|---|
| 53 | E S Y=BSDXFND X ^DD("DD") S BSDXFND=Y
|
|---|
| 54 | S BSDXI=BSDXI+1
|
|---|
| 55 | ;//smh - bug (V 1.3): Need to replace @ in FM date for C# to recognize it
|
|---|
| 56 | S BSDXFND=$TR(BSDXFND,"@"," ")
|
|---|
| 57 | ;//smh end fix
|
|---|
| 58 | S ^BSDXTMP($J,BSDXI)="1^"_BSDXFND_"^"_$C(30)_$C(31)
|
|---|
| 59 | Q
|
|---|
| 60 | SETRBKD(BSDXY,BSDXAPPT,BSDXDATE) ;EP
|
|---|
| 61 | ;Entry point for debugging
|
|---|
| 62 | ;
|
|---|
| 63 | ;D DEBUG^%Serenji("SETRBK^BSDX33(.BSDXY,BSDXAPPT,BSDXDATE)")
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | SETRBK(BSDXY,BSDXAPPT,BSDXDATE) ;EP
|
|---|
| 67 | ;
|
|---|
| 68 | ;Sets rebook date into appointment
|
|---|
| 69 | ;BSDXAPPT - Appointment ID
|
|---|
| 70 | ;BSDXDATE - Rebook Datetime in internal format
|
|---|
| 71 | ;Called by BSDX REBOOK SET
|
|---|
| 72 | ;
|
|---|
| 73 | ;ErrorID:
|
|---|
| 74 | ; 0 if a problem. Message in ERRORTEXT
|
|---|
| 75 | ; 1 if OK
|
|---|
| 76 | ;
|
|---|
| 77 | S X="ERROR^BSDX33",@^%ZOSF("TRAP")
|
|---|
| 78 | N BSDXI,BSDXIENS,%DT,BSDXMSG,Y
|
|---|
| 79 | S BSDXY="^BSDXTMP("_$J_")"
|
|---|
| 80 | S BSDXI=0
|
|---|
| 81 | S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
|
|---|
| 82 | ;
|
|---|
| 83 | I '+BSDXAPPT
|
|---|
| 84 | I '$D(^BSDXAPPT(BSDXAPPT,0)) D ERR(1,"BSDX REBOOK SET: Invalid appointment ID") Q
|
|---|
| 85 | ; i18n (v 1.3)
|
|---|
| 86 | ;S X=BSDXDATE,%DT="XT" D ^%DT
|
|---|
| 87 | ;I Y=-1 D ERR(1,"BSDX REBOOK SET: Invalid rebook datetime") Q
|
|---|
| 88 | ;S BSDXDATE=Y
|
|---|
| 89 | S BSDXIENS=BSDXAPPT_","
|
|---|
| 90 | S BSDXFDA(9002018.4,BSDXIENS,.11)=+BSDXDATE
|
|---|
| 91 | ;
|
|---|
| 92 | K BSDXMSG
|
|---|
| 93 | D FILE^DIE("","BSDXFDA","BSDXMSG")
|
|---|
| 94 | S BSDXI=BSDXI+1
|
|---|
| 95 | S ^BSDXTMP($J,BSDXI)="1^"_$C(31)
|
|---|
| 96 | ;
|
|---|
| 97 | Q
|
|---|
| 98 | ;
|
|---|
| 99 | ERR(BSDXERID,ERRTXT) ;Error processing
|
|---|
| 100 | S:'+$G(BSDXI) BSDXI=999999
|
|---|
| 101 | S BSDXI=BSDXI+1
|
|---|
| 102 | S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
|
|---|
| 103 | S BSDXI=BSDXI+1
|
|---|
| 104 | S ^BSDXTMP($J,BSDXI)=$C(31)
|
|---|
| 105 | Q
|
|---|
| 106 | ;
|
|---|
| 107 | ERROR ;
|
|---|
| 108 | D ^%ZTER
|
|---|
| 109 | I '+$G(BSDXI) N BSDXI S BSDXI=999999
|
|---|
| 110 | S BSDXI=BSDXI+1
|
|---|
| 111 | D ERR(0,"BSDX33 M Error: <"_$G(%ZTERROR)_">")
|
|---|
| 112 | Q
|
|---|
| 113 | ;
|
|---|
| 114 | ERR2(BSDXERID,ERRTXT) ;Error processing
|
|---|
| 115 | S:'+$G(BSDXI) BSDXI=999999
|
|---|
| 116 | S BSDXI=BSDXI+1
|
|---|
| 117 | S ^BSDXTMP($J,BSDXI)=BSDXERID_"^^"_ERRTXT_$C(30)
|
|---|
| 118 | S BSDXI=BSDXI+1
|
|---|
| 119 | S ^BSDXTMP($J,BSDXI)=$C(31)
|
|---|
| 120 | Q
|
|---|
| 121 | ;
|
|---|
| 122 | ERROR2 ;
|
|---|
| 123 | D ^%ZTER
|
|---|
| 124 | I '+$G(BSDXI) N BSDXI S BSDXI=999999
|
|---|
| 125 | S BSDXI=BSDXI+1
|
|---|
| 126 | D ERR2(0,"BSDX33 M Error: <"_$G(%ZTERROR)_">")
|
|---|
| 127 | Q
|
|---|
