| 1 | SDSCUTL ;ALB/JAM/RBS - ASCD Utility Program ; 4/24/07 4:26pm
|
---|
| 2 | ;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
|
---|
| 3 | ;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
|
---|
| 4 | ;;known as Service Connected Automated Monitoring (SCAM).
|
---|
| 5 | ;
|
---|
| 6 | Q
|
---|
| 7 | ;
|
---|
| 8 | TYPE ; Select proper user type based on security key.
|
---|
| 9 | ; called by routines: SDSCEDT,SDSCLST,SDSCMSR,SDSCRP1,SDSCSSD
|
---|
| 10 | ; sets variables: SDTYPE,SDSCTAT,SDOPT,SDSCCR
|
---|
| 11 | ; (should be killed by calling routines)
|
---|
| 12 | I $G(SDTYPE)=""!($G(SDSCTAT)="")!($G(SDOPT)="") D
|
---|
| 13 | . I $D(^XUSEC("SDSC SUPER",DUZ)) D Q
|
---|
| 14 | .. ; Supervisor can look at encounters with any status.
|
---|
| 15 | .. S SDTYPE="S",SDSCTAT="",SDOPT="SA^Y:YES;N:NO;S:SKIP;R:REVIEW"
|
---|
| 16 | .. S SDSCCR=""
|
---|
| 17 | .. Q
|
---|
| 18 | . I $D(^XUSEC("SDSC CLINICAL",DUZ)) D Q
|
---|
| 19 | .. ; Clinician can only look at encounters with a status of REVIEW.
|
---|
| 20 | .. S SDTYPE="C",SDSCTAT="R",SDOPT="SA^Y:YES;N:NO;S:SKIP;R:REVIEW"
|
---|
| 21 | .. S SDSCCR="I $P(^(0),U,5)=SDSCTAT"
|
---|
| 22 | .. Q
|
---|
| 23 | . ; User (default) can only look at encounters with a status of NEW.
|
---|
| 24 | . S SDTYPE="U",SDSCTAT="N",SDOPT="SA^Y:YES;N:NO;S:SKIP;R:REVIEW"
|
---|
| 25 | . S SDSCCR="I $P(^(0),U,5)=SDSCTAT"
|
---|
| 26 | . Q
|
---|
| 27 | Q
|
---|
| 28 | ;
|
---|
| 29 | NBFP(SDOE) ; Is first-party non-billable based on either clinic, stop code, or patient?
|
---|
| 30 | N SDOE0,SDPAT,SDOEDT
|
---|
| 31 | I $G(SDOE)="" Q 0
|
---|
| 32 | S SDOE0=$$GETOE^SDOE(SDOE),SDPAT=$P(SDOE0,U,2),SDOEDT=+SDOE0
|
---|
| 33 | I '+$$FIRST^IBRSUTL(SDOE) Q 1
|
---|
| 34 | Q 0
|
---|
| 35 | ;
|
---|
| 36 | NBTP(SDOE) ; Is third-party non-billable based on either clinic, stop code, or patient?
|
---|
| 37 | N SDOE0,SDPAT,SDOEDT,SDCOV
|
---|
| 38 | I $G(SDOE)="" Q 0
|
---|
| 39 | S SDOE0=$$GETOE^SDOE(SDOE),SDPAT=$P(SDOE0,U,2),SDOEDT=+SDOE0
|
---|
| 40 | I '+$$THIRD^IBRSUTL(SDOE) Q 1
|
---|
| 41 | ; ICR#: 4419 (SUPPORTED) - look for Outpatient coverage
|
---|
| 42 | S SDCOV=$S($$INSUR^IBBAPI(SDPAT,SDOEDT,"O","",16)<1:0,1:1)
|
---|
| 43 | I 'SDCOV Q 1
|
---|
| 44 | Q 0
|
---|
| 45 | ;
|
---|
| 46 | SENS(SDFN,SDFLG) ; Check for Sensitive Patient
|
---|
| 47 | ; Input
|
---|
| 48 | ; SDFN - Patient IEN
|
---|
| 49 | ; SDFLG - '1' if called from ListMan edit
|
---|
| 50 | ; - '0' if called from roll-and-scroll
|
---|
| 51 | ; Returns
|
---|
| 52 | ; '0' - OK to view (patient is not sensitive, user has key, or answered 'OK')
|
---|
| 53 | ; '1' - not OK to view patient (patient is sensitive, user does not have key and answered 'NO')
|
---|
| 54 | ;
|
---|
| 55 | N SDANS
|
---|
| 56 | S SDANS=0
|
---|
| 57 | I +$P($G(^DGSL(38.1,+SDFN,0)),U,2) D
|
---|
| 58 | . NEW DIC,Y,DFN,X,VADM
|
---|
| 59 | . S DFN=SDFN D DEM^VADPT
|
---|
| 60 | . I $G(SDFLG)=0 W !!,$E(VADM(1),1,25)_" ("_$E($P(VADM(2),U),6,9)_")",!!
|
---|
| 61 | . I $G(SDFLG)=1 D FULL^VALM1
|
---|
| 62 | . S DIC(0)="AE",Y=SDFN
|
---|
| 63 | . D ^DGSEC
|
---|
| 64 | . I Y<0 S SDANS=1
|
---|
| 65 | . I $D(^XUSEC("DG SENSITIVITY",DUZ)) D
|
---|
| 66 | .. ; If user holds key, prevent sensitive patient warning from scrolling off screen
|
---|
| 67 | .. N DIR W ! S DIR(0)="E" D ^DIR
|
---|
| 68 | .D KVA^VADPT
|
---|
| 69 | Q SDANS
|
---|
| 70 | ;
|
---|
| 71 | DIV ; Ask for Division
|
---|
| 72 | N SDN
|
---|
| 73 | S SDN=0
|
---|
| 74 | F S SDN=$O(^DG(40.8,SDN)) Q:'SDN D
|
---|
| 75 | . S DIR("A",SDN)=SDN_" "_$P(^DG(40.8,SDN,0),"^",1)
|
---|
| 76 | . S SCLN=SDN
|
---|
| 77 | S SCLN=SCLN+1,DIR("A",SCLN)=SCLN_" ALL"
|
---|
| 78 | S DIR(0)="L^1:"_SCLN,DIR("B")=SCLN
|
---|
| 79 | S DIR("A")="Select DIVISION"
|
---|
| 80 | Q
|
---|
| 81 | ;
|
---|
| 82 | SRV ; Ask for Clinic Service
|
---|
| 83 | N TDIR
|
---|
| 84 | S TDIR="M:MEDICINE;S:SURGERY;P:PSYCHIATRY;R:REHAB MEDICINE;N:NEUROLOGY;0:NONE;"
|
---|
| 85 | S TDIR=TDIR_"A:ALL"
|
---|
| 86 | S DIR(0)="S^"_TDIR,DIR("A")="Select SERVICE"
|
---|
| 87 | Q
|
---|
| 88 | ;
|
---|
| 89 | STEDT(SDOE,SDTYPE,SDRFLG,SDSCC) ; Store the TRACK EDITS multiple for encounter
|
---|
| 90 | ; Input:
|
---|
| 91 | ; SDOE - Encounter IEN
|
---|
| 92 | ; SDTYPE - Type of User - (Supervisor, Clinician, User)
|
---|
| 93 | ; SDRFLG - Review flag var
|
---|
| 94 | ; SDSCC - visit file service connected value (1/0)
|
---|
| 95 | ;
|
---|
| 96 | ; Output: none
|
---|
| 97 | ;
|
---|
| 98 | ; First add a new entry to the multiple.
|
---|
| 99 | Q:'$G(SDOE)
|
---|
| 100 | N DD,DO,X,DA,DIC,DIE,DLAYGO,SDIENS,SDPD,SDVBA,ERR
|
---|
| 101 | I '$D(^SDSC(409.48,SDOE,1,0)) S ^SDSC(409.48,SDOE,1,0)="^409.481^^"
|
---|
| 102 | S X=$P(^SDSC(409.48,SDOE,1,0),U,3)+1
|
---|
| 103 | S DA(1)=SDOE,DA=X,DIC="^SDSC(409.48,"_DA(1)_",1,",DIE=DIC
|
---|
| 104 | S DLAYGO=409.481,DIC("P")=DLAYGO,DIC(0)="L"
|
---|
| 105 | K DD,DO
|
---|
| 106 | D FILE^DICN
|
---|
| 107 | K DD,DO
|
---|
| 108 | ; Next update the fields within the multiple.
|
---|
| 109 | S SDIENS=$$IENS^DILF(.DA)
|
---|
| 110 | S SDPD(409.481,SDIENS,.02)=DT
|
---|
| 111 | S SDPD(409.481,SDIENS,.03)=DUZ
|
---|
| 112 | S SDPD(409.481,SDIENS,.04)=$G(SDTYPE)
|
---|
| 113 | ; If user answered "REVIEW", set the review flag to "YES".
|
---|
| 114 | ; Else, set SERV. CONNECT (OK BY USER?) field with current SC status.
|
---|
| 115 | I $G(SDRFLG)=1 S SDPD(409.481,SDIENS,.06)=1
|
---|
| 116 | E S SDPD(409.481,SDIENS,.05)=$G(SDSCC)
|
---|
| 117 | D FILE^DIE("","SDPD","ERR")
|
---|
| 118 | ;
|
---|
| 119 | ; -- If not "REVIEW" flag,
|
---|
| 120 | ; Set file;field (#409.48;.09) SERV. CONNECT (OK BY VBA/ICD?)
|
---|
| 121 | ; equal to the VBA/ICD9 match result.
|
---|
| 122 | I '$G(SDRFLG) D
|
---|
| 123 | . K SDPD,ERR
|
---|
| 124 | . S SDVBA=$$SC^SDSCAPI(,,SDOE)
|
---|
| 125 | . S SDPD(409.48,SDOE_",",.09)=$P(SDVBA,U,3)
|
---|
| 126 | . D FILE^DIE("","SDPD","ERR")
|
---|
| 127 | Q
|
---|
| 128 | ;
|
---|
| 129 | CONT ; Standard press RETURN to continue prompt.
|
---|
| 130 | N DIR,X,Y,DTOUT,DUOUT
|
---|
| 131 | S DIR(0)="EA"
|
---|
| 132 | S DIR("A")="Enter RETURN to continue "
|
---|
| 133 | D ^DIR
|
---|
| 134 | I $D(DTOUT)!$D(DUOUT) S SDQFLG=1
|
---|
| 135 | W @IOF,!,"Encounter ",SDOE," (cont'd)"
|
---|
| 136 | Q
|
---|
| 137 | ;
|
---|
| 138 | ANCPKG(SCEIEN) ;check if visit came from an ancillary package & if to continue
|
---|
| 139 | N PCEIEN,DIR,DA,X,Y
|
---|
| 140 | I '$G(SCEIEN) Q 1
|
---|
| 141 | S PCEIEN=$P($$GETOE^SDOE(SCEIEN),"^",5) I 'PCEIEN Q 1
|
---|
| 142 | I $P($G(^AUPNVSIT(PCEIEN,150)),"^",3)'="A" Q 1
|
---|
| 143 | W $C(7)
|
---|
| 144 | S DIR("A",1)="WARNING: This encounter came from another package. If it is changed"
|
---|
| 145 | S DIR("A",2)=" it will not agree with what is in the originating package."
|
---|
| 146 | S DIR("A",3)=" "
|
---|
| 147 | S DIR("A")="Do you want to continue with this encounter"
|
---|
| 148 | S DIR("B")="YES",DIR(0)="Y"
|
---|
| 149 | D ^DIR
|
---|
| 150 | Q $S(Y:1,Y<0:1,1:0)
|
---|
| 151 | NCTCL(SDCLIN) ;Checks if a non-count clinic
|
---|
| 152 | I $P($G(^SC(+SDCLIN,0)),U,17)="Y" Q 1
|
---|
| 153 | Q 0
|
---|
| 154 | SCHNG(SDOE) ;Checks if a completed encounter SC value was changed.
|
---|
| 155 | ;Input: SDOE - Encounter IEN
|
---|
| 156 | ;Output: SC Changed^Orignal Value(1 or 0)^Last Value(1 or 0)
|
---|
| 157 | ; SC Changed: 0-no change, 1-change
|
---|
| 158 | ; Null is return if invalid
|
---|
| 159 | N SDVAL,SDORG,SDUSR
|
---|
| 160 | I $G(SDOE)="" Q ""
|
---|
| 161 | S SDVAL=$G(^SDSC(409.48,SDOE,0)) I SDVAL="" Q ""
|
---|
| 162 | I $P(SDVAL,"^",5)'="C" Q ""
|
---|
| 163 | S SDORG=$P(SDVAL,U,13),SDUSR=$P(SDVAL,U,6)
|
---|
| 164 | I SDORG="" S SDORG=1
|
---|
| 165 | Q $S(SDORG=SDUSR:0,1:1)_U_SDORG_U_SDUSR
|
---|
| 166 | ;
|
---|
| 167 | LOCK(SCIEN) ;Locks an ASCD record.
|
---|
| 168 | ; This function locks an ASCD so as to prevent another process from
|
---|
| 169 | ; editing the same record.
|
---|
| 170 | ; Input: SCIEN - IEN of record in file #409.48
|
---|
| 171 | ;
|
---|
| 172 | ; Output: Returns 1 if lock was successful, 0 otherwise
|
---|
| 173 | ;
|
---|
| 174 | I $G(SCIEN) L +^SDSC(409.48,SCIEN):5
|
---|
| 175 | Q $T
|
---|
| 176 | ;
|
---|
| 177 | UNLOCK(SCIEN) ;Unlocks an ASCD record.
|
---|
| 178 | ; This function releases the lock on an ASCD record created by $$LOCK.
|
---|
| 179 | ; Input: SCIEN - IEN of record in file #409.48
|
---|
| 180 | ;
|
---|
| 181 | ; Output: None
|
---|
| 182 | ;
|
---|
| 183 | I $G(SCIEN) L -^SDSC(409.48,SCIEN)
|
---|
| 184 | Q
|
---|
| 185 | ;
|
---|
| 186 | SCSEL() ;Prompts for the type of service connection records to review.
|
---|
| 187 | ; Input: No input required
|
---|
| 188 | ; Output: 1 - SC, 0 - NSC, 2 - All and "" (null)
|
---|
| 189 | N DIR
|
---|
| 190 | W !,"Service Connected Encounters Review Selection"
|
---|
| 191 | S DIR(0)="SO^S:Service Connected;N:Non-Service Connected;A:All"
|
---|
| 192 | S DIR("B")="S",DIR("A")="Which type do you want to review?"
|
---|
| 193 | D ^DIR I $D(DIRUT) Q ""
|
---|
| 194 | Q $S(Y="S":1,Y="N":0,1:2)
|
---|