| [613] | 1 | IBPU1 ;ALB/CPM - ARCHIVE/PURGING UTILITIES (CON'T.) ; 20-APR-92
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | NODUZ() ; Check for the existence of DUZ
|
|---|
| 6 | ; Input: NONE
|
|---|
| 7 | ; Output: 0 -- has DUZ, 1 -- no DUZ
|
|---|
| 8 | N Y
|
|---|
| 9 | I $D(DUZ)[0 S Y=1 W !!,"Your DUZ code must be defined in order to use this option.",!
|
|---|
| 10 | Q +$G(Y)
|
|---|
| 11 | ;
|
|---|
| 12 | NOESIG(USER) ; Check Electronic Signature Code
|
|---|
| 13 | ; Input: USER -- ien in New Person file
|
|---|
| 14 | ; Output: 0 -- has code, 1 -- no code
|
|---|
| 15 | N Y
|
|---|
| 16 | I $P($G(^VA(200,USER,20)),"^",4)="" S Y=1 W !!,"You must enter your Electronic Signature Code in order to use this option.",!
|
|---|
| 17 | Q +$G(Y)
|
|---|
| 18 | ;
|
|---|
| 19 | ESIG(USER) ; Enter Electronic Signature Code
|
|---|
| 20 | ; Input: USER -- ien in New Person file
|
|---|
| 21 | ; Output: 0 -- not entered or '^' out, 1 -- entered OK
|
|---|
| 22 | N I,J,SIG,X,Y S SIG=$P($G(^VA(200,USER,20)),"^",4),Y=0
|
|---|
| 23 | W ! F J=1:1 Q:J=4 W !,"ENTER ELECTRONIC SIGNATURE: " X ^%ZOSF("EOFF") R X:$S($D(DTIME):DTIME,1:60) X ^%ZOSF("EON") Q:'$T!(X="")!($E(X)="^") D HASH^XUSHSHP I X=SIG S Y=1 Q
|
|---|
| 24 | W !,"Your Electronic Signature Code has " W:'Y "not " W "been verified."
|
|---|
| 25 | Q Y
|
|---|
| 26 | ;
|
|---|
| 27 | OKAY(JOB) ; Okay to queue this job?
|
|---|
| 28 | ; Input: JOB -- 1 - Search, 2 - Archive, 3 - Purge
|
|---|
| 29 | ; Output: 0 -- No, not okay, 1 -- Yes, okay to continue
|
|---|
| 30 | N DIR,DIRUT,DUOUT,DTOUT,Y
|
|---|
| 31 | S DIR(0)="Y",DIR("A")="Is it okay to queue this "_$P("search^archive^purge","^",JOB)
|
|---|
| 32 | S DIR("?",1)="Enter: 'Y' if you wish to task off this job, or"
|
|---|
| 33 | S DIR("?")=" 'N' or '^' to quit this option." W ! D ^DIR
|
|---|
| 34 | Q $S($D(DIRUT)!($D(DUOUT))!($D(DTOUT)):0,1:Y)
|
|---|
| 35 | ;
|
|---|
| 36 | TASK ; Task off job.
|
|---|
| 37 | ; Input: IBOP -- 1 - Search, 2 - Archive, 3 - Purge
|
|---|
| 38 | ; IBD( -- input data
|
|---|
| 39 | S ZTRTN="QUE^IBP",ZTDTH=$H,(ZTSAVE("IBD("),ZTSAVE("IBOP"))="",ZTIO=$S(IBOP=2:ION,1:"")
|
|---|
| 40 | S ZTDESC=$P("FIND^ARCHIVE^PURGE","^",IBOP)_" BILLING DATA"_$S(IBOP=1:" TO ARCHIVE",1:"")
|
|---|
| 41 | D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
|
|---|
| 42 | K ZTSK Q
|
|---|
| 43 | ;
|
|---|
| 44 | ;
|
|---|
| 45 | DEL(FILE) ; Delete a search template from file #.401 (Sort Templates)
|
|---|
| 46 | ; Input: FILE -- file for which template must be deleted
|
|---|
| 47 | ; Output: None
|
|---|
| 48 | N DA,DIK,TMPL
|
|---|
| 49 | S DA=$$LOGIEN(FILE)
|
|---|
| 50 | S TMPL=$P($G(^IBE(350.6,DA,0)),"^",2)
|
|---|
| 51 | I TMPL]"" S DA=$O(^DIBT("B",TMPL,0)) I DA S DIK="^DIBT(" D ^DIK
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | UPD(LOG,FIELD,VALUE) ; Update/Delete Log Entry fields
|
|---|
| 55 | ; Input: LOG -- ien of log entry to be updated
|
|---|
| 56 | ; FIELD -- field number of field being updated
|
|---|
| 57 | ; VALUE -- value to be stuffed into field
|
|---|
| 58 | ; Output: NONE
|
|---|
| 59 | N DA,DR,DIE
|
|---|
| 60 | S DIE="^IBE(350.6,",DA=LOG,DR=FIELD_"///"_VALUE D ^DIE
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | LOGIEN(FILE) ; Find the most current log entry for a file
|
|---|
| 64 | ; Input: FILE -- file for which log entry must be deleted
|
|---|
| 65 | ; Output: ien of most current log entry for a file
|
|---|
| 66 | Q +$O(^(+$O(^IBE(350.6,"AF",FILE,"")),0))
|
|---|
