- PSOEPED ;JLI/FO-OAKLAND-RPC to handle epcs data changes ;7/29/21 09:53
- ;;7.0;OUTPATIENT PHARMACY;**545,735**;DEC 1997;Build 6
- ;Reference to DEA NUMBERS file (#8991.9) is supported by DBIA 7002
- ;Reference to XUEPCS DATA file (#8991.6) is supported by DBIA 7015
- ;Reference to XUEPCS PSDRPH AUDIT file (#8991.7) is supported by DBIA 7016
- ;Reference to KEYS sub-file (#200.051) is supported by DBIA 7054
- ;Reference to SIGN-ON LOG file (#3.081) is supported by ICR 7436
- Q
- ;
- ENTRY(RESULT,INPUT) ;.remoteprocedure
- NEW I,NOW
- SET NOW=$P($$HTE^XLFDT($H),":",1,2)
- FOR I=-1:0 SET I=$O(INPUT(I)) QUIT:I="" DO RECORD(INPUT(I),NOW)
- SET RESULT=1
- QUIT
- ;
- RECORD(LINE,NOW) ;
- N FDA,VALUE,IEN,MSG,I
- FOR I=1:1:5 SET VALUE=$P(LINE,U,I),FDA(8991.6,"+1,",(I/100))=VALUE
- SET FDA(8991.6,"+1,",.06)=NOW
- SET FDA(8991.6,"+1,",.07)=$P(LINE,U,6)
- SET FDA(8991.6,"+1,",.08)=$P(LINE,U,7)
- DO UPDATE^DIE("E","FDA","IEN","MSG")
- QUIT
- ;
- PRINT ; print audit logs as indicated
- NEW DIR,I,VAL,X,Y,BY,DIC,FLDS,L
- SET DIR(0)="S^"
- FOR I=1:1:6 SET X=$T(SORTTYPE+I),DIR(0)=DIR(0)_$SELECT(I>1:";",1:"")_I_":"_$PIECE(X,";",3),VAL(I)=$PIECE(X,";",4)
- SET DIR("A")="SORT BY" DO ^DIR IF +$GET(Y)'>0 QUIT
- SET BY=VAL(+Y),FLDS=".06,.01,.02,.03,.04,.05",DIC=8991.6,L="" DO EN1^DIP
- QUIT
- ;
- SORTTYPE ; specifies sort types for selection
- ;;Sort by Edited By then Date/time;.02,.06,.01
- ;;Sort by Edited By then User Edited;.02,.01,.06
- ;;Sort by Date/time then Edited By;.06,.02,.01
- ;;Sort by Date/time then User Edited;.06,.01,.02
- ;;Sort by User Edited then Edited By;.01,.02,.06
- ;;Sort by User Edited then Date;.01,.06,.02
- ; .01 .02 .06
- ; User Edited, Edited by, Date/Time Edited
- ;
- LASTCRED(RETURN,INDUZ) ; Get last CREDENTIAL TYPE field (#102) from SIGN-ON LOG file (#3.081)
- ; INPUT : INDUZ - User Internal Entry Number
- ; OUTPUT : Credential Code from Set of Codes
- ; 1 - AVCODES
- ; 2 - SSOI
- ; 3 - SSOE
- ; 4 - BSETOKEN
- ; 5 - CCOWTOKEN
- ; 6 - ASHTOKEN
- ; 7 - NHIN
- ; 8 - NONE
- ; 9 - UNKNOWN
- ;
- N CREDTM
- K RETURN S RETURN=8
- I '$G(INDUZ) S RETURN=9 Q
- I '$L($G(^VA(200,+INDUZ,0))) S RETURN=9 Q
- I INDUZ'=+$G(DUZ) Q
- S CREDTM=$G(DUZ("AUTHENTICATION"))
- S RETURN=$S(CREDTM="AVCODES":1,CREDTM="SSOI":2,CREDTM="SSOE":3,CREDTM="BSETOKEN":4,CREDTM="CCOWTOKEN":5,CREDTM="ASHTOKEN":6,CREDTM="NHIN":7,1:9)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOEPED 2447 printed Feb 18, 2025@23:53:58 Page 2
- PSOEPED ;JLI/FO-OAKLAND-RPC to handle epcs data changes ;7/29/21 09:53
- +1 ;;7.0;OUTPATIENT PHARMACY;**545,735**;DEC 1997;Build 6
- +2 ;Reference to DEA NUMBERS file (#8991.9) is supported by DBIA 7002
- +3 ;Reference to XUEPCS DATA file (#8991.6) is supported by DBIA 7015
- +4 ;Reference to XUEPCS PSDRPH AUDIT file (#8991.7) is supported by DBIA 7016
- +5 ;Reference to KEYS sub-file (#200.051) is supported by DBIA 7054
- +6 ;Reference to SIGN-ON LOG file (#3.081) is supported by ICR 7436
- +7 QUIT
- +8 ;
- ENTRY(RESULT,INPUT) ;.remoteprocedure
- +1 NEW I,NOW
- +2 SET NOW=$PIECE($$HTE^XLFDT($HOROLOG),":",1,2)
- +3 FOR I=-1:0
- SET I=$ORDER(INPUT(I))
- if I=""
- QUIT
- DO RECORD(INPUT(I),NOW)
- +4 SET RESULT=1
- +5 QUIT
- +6 ;
- RECORD(LINE,NOW) ;
- +1 NEW FDA,VALUE,IEN,MSG,I
- +2 FOR I=1:1:5
- SET VALUE=$PIECE(LINE,U,I)
- SET FDA(8991.6,"+1,",(I/100))=VALUE
- +3 SET FDA(8991.6,"+1,",.06)=NOW
- +4 SET FDA(8991.6,"+1,",.07)=$PIECE(LINE,U,6)
- +5 SET FDA(8991.6,"+1,",.08)=$PIECE(LINE,U,7)
- +6 DO UPDATE^DIE("E","FDA","IEN","MSG")
- +7 QUIT
- +8 ;
- PRINT ; print audit logs as indicated
- +1 NEW DIR,I,VAL,X,Y,BY,DIC,FLDS,L
- +2 SET DIR(0)="S^"
- +3 FOR I=1:1:6
- SET X=$TEXT(SORTTYPE+I)
- SET DIR(0)=DIR(0)_$SELECT(I>1:";",1:"")_I_":"_$PIECE(X,";",3)
- SET VAL(I)=$PIECE(X,";",4)
- +4 SET DIR("A")="SORT BY"
- DO ^DIR
- IF +$GET(Y)'>0
- QUIT
- +5 SET BY=VAL(+Y)
- SET FLDS=".06,.01,.02,.03,.04,.05"
- SET DIC=8991.6
- SET L=""
- DO EN1^DIP
- +6 QUIT
- +7 ;
- SORTTYPE ; specifies sort types for selection
- +1 ;;Sort by Edited By then Date/time;.02,.06,.01
- +2 ;;Sort by Edited By then User Edited;.02,.01,.06
- +3 ;;Sort by Date/time then Edited By;.06,.02,.01
- +4 ;;Sort by Date/time then User Edited;.06,.01,.02
- +5 ;;Sort by User Edited then Edited By;.01,.02,.06
- +6 ;;Sort by User Edited then Date;.01,.06,.02
- +7 ; .01 .02 .06
- +8 ; User Edited, Edited by, Date/Time Edited
- +9 ;
- LASTCRED(RETURN,INDUZ) ; Get last CREDENTIAL TYPE field (#102) from SIGN-ON LOG file (#3.081)
- +1 ; INPUT : INDUZ - User Internal Entry Number
- +2 ; OUTPUT : Credential Code from Set of Codes
- +3 ; 1 - AVCODES
- +4 ; 2 - SSOI
- +5 ; 3 - SSOE
- +6 ; 4 - BSETOKEN
- +7 ; 5 - CCOWTOKEN
- +8 ; 6 - ASHTOKEN
- +9 ; 7 - NHIN
- +10 ; 8 - NONE
- +11 ; 9 - UNKNOWN
- +12 ;
- +13 NEW CREDTM
- +14 KILL RETURN
- SET RETURN=8
- +15 IF '$GET(INDUZ)
- SET RETURN=9
- QUIT
- +16 IF '$LENGTH($GET(^VA(200,+INDUZ,0)))
- SET RETURN=9
- QUIT
- +17 IF INDUZ'=+$GET(DUZ)
- QUIT
- +18 SET CREDTM=$GET(DUZ("AUTHENTICATION"))
- +19 SET RETURN=$SELECT(CREDTM="AVCODES":1,CREDTM="SSOI":2,CREDTM="SSOE":3,CREDTM="BSETOKEN":4,CREDTM="CCOWTOKEN":5,CREDTM="ASHTOKEN":6,CREDTM="NHIN":7,1:9)
- +20 QUIT