PSODEAED ;JLI/FO-OAKLAND-RPC to handle epcs data changes ;08/24/12 11:56
;;7.0;OUTPATIENT PHARMACY;**545,731**;DEC 1997;Build 18
;External reference to XUEPCS DATA file (#8991.6) is supported by DBIA 7015
;
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
;
SCHST(INSCHAR,OUTSCHAR) ; Build schedule string from schedule array
; INPUT: SCHAR - Array of schedules, example SCHAR(55.1,"E")=0 or 1
N SCHFLD,NODE,FNODE,TNODE S SCHFLD=0
F S SCHFLD=$O(INSCHAR(SCHFLD)) Q:'SCHFLD D
.S NODE=$P(SCHFLD,".",2),TNODE=2_"."_NODE,FNODE=55_"."_NODE
.S OUTSCHAR(TNODE)=$S($E($G(INSCHAR(FNODE,"E")))="Y":"YES",1:"NO")
Q
;
INIT ; Initialize the List Array for Listman PSO DEA NUMBER MANAGEMENT
N LINE,DLINE,CNAME,DS,DSTMP,DTRESULT,NAME,BAC,PSAR,PSAR2
S DNDEAIEN=$O(^XTV(8991.9,"B",DEATXT,0))
I '$D(GETS) D GETS^PSODEAUT(DNDEAIEN,.GETS) D
.I $G(NPIEN),($G(GETS(.07))="INSTITUTIONAL") D LSCHED^PSODEAME(.GETS) ; Get Local Schedules if Institutional DEA
; Special State Processing
N XSTATE,XIP
D POSTAL^XIPUTIL($G(FG("zipCode")),.XIP)
S XSTATE=$G(XIP("STATE"))
I XSTATE'="" S FG("state")=XSTATE ; Pointer to the State File #5.
;
S LINE=1
;
S NAME="name",DLINE=""
S CNAME=$S($D(CN(NAME)):CN(NAME),1:NAME)
S DSTMP=$S(FG(NAME)'=$G(GETS(1.1)):"**",1:"")
S DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
S DLINE=$$SETFLD^VALM1(FG(NAME)_DSTMP,DLINE,"DOJ/DEA VALUE")
S DLINE=$$SETFLD^VALM1($G(GETS(1.1)),DLINE,"LOCAL VALUE")
D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
S NAME="additionalCompanyInfo",DLINE=""
S CNAME=$S($D(CN(NAME)):CN(NAME),1:NAME)
S DSTMP=$S(FG(NAME)'=$G(GETS(1.2)):"**",1:"")
S DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
S DLINE=$$SETFLD^VALM1(FG(NAME)_DSTMP,DLINE,"DOJ/DEA VALUE")
S DLINE=$$SETFLD^VALM1($G(GETS(1.2)),DLINE,"LOCAL VALUE")
D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
S NAME="address1",DLINE=""
S CNAME=$S($D(CN(NAME)):CN(NAME),1:NAME)
S DSTMP=$S(FG(NAME)'=$G(GETS(1.3)):"**",1:"")
S DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
S DLINE=$$SETFLD^VALM1(FG(NAME)_DSTMP,DLINE,"DOJ/DEA VALUE")
S DLINE=$$SETFLD^VALM1($G(GETS(1.3)),DLINE,"LOCAL VALUE")
D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
S NAME="address2",DLINE=""
S CNAME=$S($D(CN(NAME)):CN(NAME),1:NAME)
S DSTMP=$S(FG(NAME)'=$G(GETS(1.4)):"**",1:"")
S DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
S DLINE=$$SETFLD^VALM1(FG(NAME)_DSTMP,DLINE,"DOJ/DEA VALUE")
S DLINE=$$SETFLD^VALM1($G(GETS(1.4)),DLINE,"LOCAL VALUE")
D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
S NAME="city",DLINE=""
S CNAME=$S($D(CN(NAME)):CN(NAME),1:NAME)
S DSTMP=$S(FG(NAME)'=$G(GETS(1.5)):"**",1:"")
S DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
S DLINE=$$SETFLD^VALM1(FG(NAME)_DSTMP,DLINE,"DOJ/DEA VALUE")
S DLINE=$$SETFLD^VALM1($G(GETS(1.5)),DLINE,"LOCAL VALUE")
D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
S NAME="state",DLINE=""
S CNAME=$S($D(CN(NAME)):CN(NAME),1:NAME)
S DSTMP=$S(FG(NAME)'=$G(GETS(1.6)):"**",1:"")
S DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
S DLINE=$$SETFLD^VALM1(FG(NAME)_DSTMP,DLINE,"DOJ/DEA VALUE")
S DLINE=$$SETFLD^VALM1($G(GETS(1.6)),DLINE,"LOCAL VALUE")
D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
S NAME="zipCode",DLINE=""
S CNAME=$S($D(CN(NAME)):CN(NAME),1:NAME)
S DSTMP=$S(FG(NAME)'=$G(GETS(1.7)):"**",1:"")
S DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
S DLINE=$$SETFLD^VALM1(FG(NAME)_DSTMP,DLINE,"DOJ/DEA VALUE")
S DLINE=$$SETFLD^VALM1($G(GETS(1.7)),DLINE,"LOCAL VALUE")
D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
S NAME="businessActivityCode",DLINE=""
S CNAME=$S($D(CN(NAME)):CN(NAME),1:NAME)
S DSTMP=$S(FG(NAME)_$G(FG("businessActivitySubcode"))'=$G(GETS(.02)):"**",1:"")
S DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
S DLINE=$$SETFLD^VALM1(FG(NAME)_$G(FG("businessActivitySubcode"))_DSTMP,DLINE,"DOJ/DEA VALUE")
S DLINE=$$SETFLD^VALM1($G(GETS(.02)),DLINE,"LOCAL VALUE")
D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
S NAME="type",DLINE=""
S CNAME=$S($D(CN(NAME)):CN(NAME),1:NAME)
S DSTMP=$S(FG(NAME)'=$G(GETS(.07)):"**",1:"")
S DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
S DLINE=$$SETFLD^VALM1(FG(NAME)_DSTMP,DLINE,"DOJ/DEA VALUE")
S DLINE=$$SETFLD^VALM1($G(GETS(.07)),DLINE,"LOCAL VALUE")
D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
S NAME="deaNumber",DLINE=""
S CNAME=$S($D(CN(NAME)):CN(NAME),1:NAME)
S DSTMP=$S(FG(NAME)'=$G(GETS(.01)):"**",1:"")
S DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
S DLINE=$$SETFLD^VALM1(FG(NAME)_DSTMP,DLINE,"DOJ/DEA VALUE")
S DLINE=$$SETFLD^VALM1($G(GETS(.01)),DLINE,"LOCAL VALUE")
D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
; DETOX NUMBER DISPLAY
;P731 detox/x-waiver removal
;S BAC=$G(FG("businessActivityCode"))_$G(FG("businessActivitySubcode"))
;S DLINE=""
;S DSTMP=$S($$DETOXCHK^PSODEAUT(BAC):"X"_$E(FG(NAME),2,9),1:"")
;S DSTMP=DSTMP_$S(DSTMP'=$G(GETS(.03)):"**",1:"")
;S DLINE=$$SETFLD^VALM1("DETOX NUMBER:",DLINE,"NAME")
;S DLINE=$$SETFLD^VALM1(DSTMP,DLINE,"DOJ/DEA VALUE")
;S DLINE=$$SETFLD^VALM1($G(GETS(.03)),DLINE,"LOCAL VALUE")
;D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
S NAME="expirationDate",DLINE="",DSTMP=""
S CNAME=$S($D(CN(NAME)):CN(NAME),1:NAME)
D DT^DILF("E",FG(NAME),.DTRESULT)
S:$D(DTRESULT(0)) DSTMP=$S(DTRESULT(0)'=$G(GETS(.04)):"**",1:"")
S DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
S DLINE=$$SETFLD^VALM1($G(DTRESULT(0))_DSTMP,DLINE,"DOJ/DEA VALUE")
S DLINE=$$SETFLD^VALM1($G(GETS(.04)),DLINE,"LOCAL VALUE")
D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
S NAME="drugSchedule",DLINE=""
S DS=$G(FG("drugSchedule"))
;
; Set NDROOT to "2" (file 8991.9 schedule fields root) if INDIVIDUAL DEA
; Set NDROOT to "55" (file 200 schedule fields root) if INSTITUTIONAL DEA
;
N NDROOT S NDROOT=$S($G(GETS(.07))="INSTITUTIONAL":55,1:2)
;I $G(GETS(.07))="INSTITUTIONAL" D LSCHED^PSODEAME(.GETS) ; Get Local Schedules if Institutional DEA
;
; SCHEDULE II NARCOTIC
S DLINE=$$SETFLD^VALM1("SCH II NARC:",DLINE,"NAME")
S DSTMP=$S(DS["22N":"YES",(DS["2"&(DS'["2N")):"YES",1:"NO")
S DSTMP=DSTMP_$S(DSTMP'=$G(GETS(NDROOT_".1")):"**",1:"")
S DLINE=$$SETFLD^VALM1(DSTMP,DLINE,"DOJ/DEA VALUE")
S DLINE=$$SETFLD^VALM1($G(GETS(NDROOT_".1")),DLINE,"LOCAL VALUE")
D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
; SCHEDULE II NON-NARCOTIC
S DLINE=$$SETFLD^VALM1("SCH II NON-NARC:",DLINE,"NAME")
S DSTMP=$S(DS["2N":"YES",1:"NO")
S DSTMP=DSTMP_$S(DSTMP'=$G(GETS(NDROOT_".2")):"**",1:"")
S DLINE=$$SETFLD^VALM1(DSTMP,DLINE,"DOJ/DEA VALUE")
S DLINE=$$SETFLD^VALM1($G(GETS(NDROOT_".2")),DLINE,"LOCAL VALUE")
D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
; SCHEDULE III NARCOTIC
S DLINE=$$SETFLD^VALM1("SCH III NARC:",DLINE,"NAME")
S DSTMP=$S(DS["33N":"YES",DS["3"&(DS'["3N"):"YES",1:"NO")
S DSTMP=DSTMP_$S(DSTMP'=$G(GETS(NDROOT_".3")):"**",1:"")
S DLINE=$$SETFLD^VALM1(DSTMP,DLINE,"DOJ/DEA VALUE")
S DLINE=$$SETFLD^VALM1($G(GETS(NDROOT_".3")),DLINE,"LOCAL VALUE")
D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
; SCHEDULE III NON-NARCOTIC
S DLINE=$$SETFLD^VALM1("SCH III NON-NARC:",DLINE,"NAME")
S DSTMP=$S(DS["3N":"YES",1:"NO")
S DSTMP=DSTMP_$S(DSTMP'=$G(GETS(NDROOT_".4")):"**",1:"")
S DLINE=$$SETFLD^VALM1(DSTMP,DLINE,"DOJ/DEA VALUE")
S DLINE=$$SETFLD^VALM1($G(GETS(NDROOT_".4")),DLINE,"LOCAL VALUE")
D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
; SCHEDULE IV
S DLINE=$$SETFLD^VALM1("SCH IV:",DLINE,"NAME")
S DSTMP=$S(DS["4":"YES",1:"NO")
S DSTMP=DSTMP_$S(DSTMP'=$G(GETS(NDROOT_".5")):"**",1:"")
S DLINE=$$SETFLD^VALM1(DSTMP,DLINE,"DOJ/DEA VALUE")
S DLINE=$$SETFLD^VALM1($G(GETS(NDROOT_".5")),DLINE,"LOCAL VALUE")
D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
; SCHEDULE V
S DLINE=$$SETFLD^VALM1("SCH V:",DLINE,"NAME")
S DSTMP=$S(DS["5":"YES",1:"NO") ; SCHEDULE V
S DSTMP=DSTMP_$S(DSTMP'=$G(GETS(NDROOT_".6")):"**",1:"")
S DLINE=$$SETFLD^VALM1(DSTMP,DLINE,"DOJ/DEA VALUE")
S DLINE=$$SETFLD^VALM1($G(GETS(NDROOT_".6")),DLINE,"LOCAL VALUE")
D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
S NAME="processedDate",DLINE=""
S CNAME=$S($D(CN(NAME)):CN(NAME),1:NAME)
D DT^DILF("E",FG(NAME),.DTRESULT)
S:$D(DTRESULT(0)) DSTMP=$S(DTRESULT(0)'=$G(GETS(10.3)):"**",1:"")
S DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
S DLINE=$$SETFLD^VALM1($G(DTRESULT(0))_DSTMP,DLINE,"DOJ/DEA VALUE")
S DLINE=$$SETFLD^VALM1($G(GETS(10.3)),DLINE,"LOCAL VALUE")
D SET^VALM10(LINE,DLINE) S LINE=LINE+1
;
S VALMCNT=LINE-1
Q
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODEAED 9144 printed Sep 23, 2025@20:02:49 Page 2
PSODEAED ;JLI/FO-OAKLAND-RPC to handle epcs data changes ;08/24/12 11:56
+1 ;;7.0;OUTPATIENT PHARMACY;**545,731**;DEC 1997;Build 18
+2 ;External reference to XUEPCS DATA file (#8991.6) is supported by DBIA 7015
+3 ;
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 ;
SCHST(INSCHAR,OUTSCHAR) ; Build schedule string from schedule array
+1 ; INPUT: SCHAR - Array of schedules, example SCHAR(55.1,"E")=0 or 1
+2 NEW SCHFLD,NODE,FNODE,TNODE
SET SCHFLD=0
+3 FOR
SET SCHFLD=$ORDER(INSCHAR(SCHFLD))
if 'SCHFLD
QUIT
Begin DoDot:1
+4 SET NODE=$PIECE(SCHFLD,".",2)
SET TNODE=2_"."_NODE
SET FNODE=55_"."_NODE
+5 SET OUTSCHAR(TNODE)=$SELECT($EXTRACT($GET(INSCHAR(FNODE,"E")))="Y":"YES",1:"NO")
End DoDot:1
+6 QUIT
+7 ;
INIT ; Initialize the List Array for Listman PSO DEA NUMBER MANAGEMENT
+1 NEW LINE,DLINE,CNAME,DS,DSTMP,DTRESULT,NAME,BAC,PSAR,PSAR2
+2 SET DNDEAIEN=$ORDER(^XTV(8991.9,"B",DEATXT,0))
+3 IF '$DATA(GETS)
DO GETS^PSODEAUT(DNDEAIEN,.GETS)
Begin DoDot:1
+4 ; Get Local Schedules if Institutional DEA
IF $GET(NPIEN)
IF ($GET(GETS(.07))="INSTITUTIONAL")
DO LSCHED^PSODEAME(.GETS)
End DoDot:1
+5 ; Special State Processing
+6 NEW XSTATE,XIP
+7 DO POSTAL^XIPUTIL($GET(FG("zipCode")),.XIP)
+8 SET XSTATE=$GET(XIP("STATE"))
+9 ; Pointer to the State File #5.
IF XSTATE'=""
SET FG("state")=XSTATE
+10 ;
+11 SET LINE=1
+12 ;
+13 SET NAME="name"
SET DLINE=""
+14 SET CNAME=$SELECT($DATA(CN(NAME)):CN(NAME),1:NAME)
+15 SET DSTMP=$SELECT(FG(NAME)'=$GET(GETS(1.1)):"**",1:"")
+16 SET DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
+17 SET DLINE=$$SETFLD^VALM1(FG(NAME)_DSTMP,DLINE,"DOJ/DEA VALUE")
+18 SET DLINE=$$SETFLD^VALM1($GET(GETS(1.1)),DLINE,"LOCAL VALUE")
+19 DO SET^VALM10(LINE,DLINE)
SET LINE=LINE+1
+20 ;
+21 SET NAME="additionalCompanyInfo"
SET DLINE=""
+22 SET CNAME=$SELECT($DATA(CN(NAME)):CN(NAME),1:NAME)
+23 SET DSTMP=$SELECT(FG(NAME)'=$GET(GETS(1.2)):"**",1:"")
+24 SET DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
+25 SET DLINE=$$SETFLD^VALM1(FG(NAME)_DSTMP,DLINE,"DOJ/DEA VALUE")
+26 SET DLINE=$$SETFLD^VALM1($GET(GETS(1.2)),DLINE,"LOCAL VALUE")
+27 DO SET^VALM10(LINE,DLINE)
SET LINE=LINE+1
+28 ;
+29 SET NAME="address1"
SET DLINE=""
+30 SET CNAME=$SELECT($DATA(CN(NAME)):CN(NAME),1:NAME)
+31 SET DSTMP=$SELECT(FG(NAME)'=$GET(GETS(1.3)):"**",1:"")
+32 SET DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
+33 SET DLINE=$$SETFLD^VALM1(FG(NAME)_DSTMP,DLINE,"DOJ/DEA VALUE")
+34 SET DLINE=$$SETFLD^VALM1($GET(GETS(1.3)),DLINE,"LOCAL VALUE")
+35 DO SET^VALM10(LINE,DLINE)
SET LINE=LINE+1
+36 ;
+37 SET NAME="address2"
SET DLINE=""
+38 SET CNAME=$SELECT($DATA(CN(NAME)):CN(NAME),1:NAME)
+39 SET DSTMP=$SELECT(FG(NAME)'=$GET(GETS(1.4)):"**",1:"")
+40 SET DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
+41 SET DLINE=$$SETFLD^VALM1(FG(NAME)_DSTMP,DLINE,"DOJ/DEA VALUE")
+42 SET DLINE=$$SETFLD^VALM1($GET(GETS(1.4)),DLINE,"LOCAL VALUE")
+43 DO SET^VALM10(LINE,DLINE)
SET LINE=LINE+1
+44 ;
+45 SET NAME="city"
SET DLINE=""
+46 SET CNAME=$SELECT($DATA(CN(NAME)):CN(NAME),1:NAME)
+47 SET DSTMP=$SELECT(FG(NAME)'=$GET(GETS(1.5)):"**",1:"")
+48 SET DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
+49 SET DLINE=$$SETFLD^VALM1(FG(NAME)_DSTMP,DLINE,"DOJ/DEA VALUE")
+50 SET DLINE=$$SETFLD^VALM1($GET(GETS(1.5)),DLINE,"LOCAL VALUE")
+51 DO SET^VALM10(LINE,DLINE)
SET LINE=LINE+1
+52 ;
+53 SET NAME="state"
SET DLINE=""
+54 SET CNAME=$SELECT($DATA(CN(NAME)):CN(NAME),1:NAME)
+55 SET DSTMP=$SELECT(FG(NAME)'=$GET(GETS(1.6)):"**",1:"")
+56 SET DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
+57 SET DLINE=$$SETFLD^VALM1(FG(NAME)_DSTMP,DLINE,"DOJ/DEA VALUE")
+58 SET DLINE=$$SETFLD^VALM1($GET(GETS(1.6)),DLINE,"LOCAL VALUE")
+59 DO SET^VALM10(LINE,DLINE)
SET LINE=LINE+1
+60 ;
+61 SET NAME="zipCode"
SET DLINE=""
+62 SET CNAME=$SELECT($DATA(CN(NAME)):CN(NAME),1:NAME)
+63 SET DSTMP=$SELECT(FG(NAME)'=$GET(GETS(1.7)):"**",1:"")
+64 SET DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
+65 SET DLINE=$$SETFLD^VALM1(FG(NAME)_DSTMP,DLINE,"DOJ/DEA VALUE")
+66 SET DLINE=$$SETFLD^VALM1($GET(GETS(1.7)),DLINE,"LOCAL VALUE")
+67 DO SET^VALM10(LINE,DLINE)
SET LINE=LINE+1
+68 ;
+69 SET NAME="businessActivityCode"
SET DLINE=""
+70 SET CNAME=$SELECT($DATA(CN(NAME)):CN(NAME),1:NAME)
+71 SET DSTMP=$SELECT(FG(NAME)_$GET(FG("businessActivitySubcode"))'=$GET(GETS(.02)):"**",1:"")
+72 SET DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
+73 SET DLINE=$$SETFLD^VALM1(FG(NAME)_$GET(FG("businessActivitySubcode"))_DSTMP,DLINE,"DOJ/DEA VALUE")
+74 SET DLINE=$$SETFLD^VALM1($GET(GETS(.02)),DLINE,"LOCAL VALUE")
+75 DO SET^VALM10(LINE,DLINE)
SET LINE=LINE+1
+76 ;
+77 SET NAME="type"
SET DLINE=""
+78 SET CNAME=$SELECT($DATA(CN(NAME)):CN(NAME),1:NAME)
+79 SET DSTMP=$SELECT(FG(NAME)'=$GET(GETS(.07)):"**",1:"")
+80 SET DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
+81 SET DLINE=$$SETFLD^VALM1(FG(NAME)_DSTMP,DLINE,"DOJ/DEA VALUE")
+82 SET DLINE=$$SETFLD^VALM1($GET(GETS(.07)),DLINE,"LOCAL VALUE")
+83 DO SET^VALM10(LINE,DLINE)
SET LINE=LINE+1
+84 ;
+85 SET NAME="deaNumber"
SET DLINE=""
+86 SET CNAME=$SELECT($DATA(CN(NAME)):CN(NAME),1:NAME)
+87 SET DSTMP=$SELECT(FG(NAME)'=$GET(GETS(.01)):"**",1:"")
+88 SET DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
+89 SET DLINE=$$SETFLD^VALM1(FG(NAME)_DSTMP,DLINE,"DOJ/DEA VALUE")
+90 SET DLINE=$$SETFLD^VALM1($GET(GETS(.01)),DLINE,"LOCAL VALUE")
+91 DO SET^VALM10(LINE,DLINE)
SET LINE=LINE+1
+92 ;
+93 ; DETOX NUMBER DISPLAY
+94 ;P731 detox/x-waiver removal
+95 ;S BAC=$G(FG("businessActivityCode"))_$G(FG("businessActivitySubcode"))
+96 ;S DLINE=""
+97 ;S DSTMP=$S($$DETOXCHK^PSODEAUT(BAC):"X"_$E(FG(NAME),2,9),1:"")
+98 ;S DSTMP=DSTMP_$S(DSTMP'=$G(GETS(.03)):"**",1:"")
+99 ;S DLINE=$$SETFLD^VALM1("DETOX NUMBER:",DLINE,"NAME")
+100 ;S DLINE=$$SETFLD^VALM1(DSTMP,DLINE,"DOJ/DEA VALUE")
+101 ;S DLINE=$$SETFLD^VALM1($G(GETS(.03)),DLINE,"LOCAL VALUE")
+102 ;D SET^VALM10(LINE,DLINE) S LINE=LINE+1
+103 ;
+104 SET NAME="expirationDate"
SET DLINE=""
SET DSTMP=""
+105 SET CNAME=$SELECT($DATA(CN(NAME)):CN(NAME),1:NAME)
+106 DO DT^DILF("E",FG(NAME),.DTRESULT)
+107 if $DATA(DTRESULT(0))
SET DSTMP=$SELECT(DTRESULT(0)'=$GET(GETS(.04)):"**",1:"")
+108 SET DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
+109 SET DLINE=$$SETFLD^VALM1($GET(DTRESULT(0))_DSTMP,DLINE,"DOJ/DEA VALUE")
+110 SET DLINE=$$SETFLD^VALM1($GET(GETS(.04)),DLINE,"LOCAL VALUE")
+111 DO SET^VALM10(LINE,DLINE)
SET LINE=LINE+1
+112 ;
+113 SET NAME="drugSchedule"
SET DLINE=""
+114 SET DS=$GET(FG("drugSchedule"))
+115 ;
+116 ; Set NDROOT to "2" (file 8991.9 schedule fields root) if INDIVIDUAL DEA
+117 ; Set NDROOT to "55" (file 200 schedule fields root) if INSTITUTIONAL DEA
+118 ;
+119 NEW NDROOT
SET NDROOT=$SELECT($GET(GETS(.07))="INSTITUTIONAL":55,1:2)
+120 ;I $G(GETS(.07))="INSTITUTIONAL" D LSCHED^PSODEAME(.GETS) ; Get Local Schedules if Institutional DEA
+121 ;
+122 ; SCHEDULE II NARCOTIC
+123 SET DLINE=$$SETFLD^VALM1("SCH II NARC:",DLINE,"NAME")
+124 SET DSTMP=$SELECT(DS["22N":"YES",(DS["2"&(DS'["2N")):"YES",1:"NO")
+125 SET DSTMP=DSTMP_$SELECT(DSTMP'=$GET(GETS(NDROOT_".1")):"**",1:"")
+126 SET DLINE=$$SETFLD^VALM1(DSTMP,DLINE,"DOJ/DEA VALUE")
+127 SET DLINE=$$SETFLD^VALM1($GET(GETS(NDROOT_".1")),DLINE,"LOCAL VALUE")
+128 DO SET^VALM10(LINE,DLINE)
SET LINE=LINE+1
+129 ;
+130 ; SCHEDULE II NON-NARCOTIC
+131 SET DLINE=$$SETFLD^VALM1("SCH II NON-NARC:",DLINE,"NAME")
+132 SET DSTMP=$SELECT(DS["2N":"YES",1:"NO")
+133 SET DSTMP=DSTMP_$SELECT(DSTMP'=$GET(GETS(NDROOT_".2")):"**",1:"")
+134 SET DLINE=$$SETFLD^VALM1(DSTMP,DLINE,"DOJ/DEA VALUE")
+135 SET DLINE=$$SETFLD^VALM1($GET(GETS(NDROOT_".2")),DLINE,"LOCAL VALUE")
+136 DO SET^VALM10(LINE,DLINE)
SET LINE=LINE+1
+137 ;
+138 ; SCHEDULE III NARCOTIC
+139 SET DLINE=$$SETFLD^VALM1("SCH III NARC:",DLINE,"NAME")
+140 SET DSTMP=$SELECT(DS["33N":"YES",DS["3"&(DS'["3N"):"YES",1:"NO")
+141 SET DSTMP=DSTMP_$SELECT(DSTMP'=$GET(GETS(NDROOT_".3")):"**",1:"")
+142 SET DLINE=$$SETFLD^VALM1(DSTMP,DLINE,"DOJ/DEA VALUE")
+143 SET DLINE=$$SETFLD^VALM1($GET(GETS(NDROOT_".3")),DLINE,"LOCAL VALUE")
+144 DO SET^VALM10(LINE,DLINE)
SET LINE=LINE+1
+145 ;
+146 ; SCHEDULE III NON-NARCOTIC
+147 SET DLINE=$$SETFLD^VALM1("SCH III NON-NARC:",DLINE,"NAME")
+148 SET DSTMP=$SELECT(DS["3N":"YES",1:"NO")
+149 SET DSTMP=DSTMP_$SELECT(DSTMP'=$GET(GETS(NDROOT_".4")):"**",1:"")
+150 SET DLINE=$$SETFLD^VALM1(DSTMP,DLINE,"DOJ/DEA VALUE")
+151 SET DLINE=$$SETFLD^VALM1($GET(GETS(NDROOT_".4")),DLINE,"LOCAL VALUE")
+152 DO SET^VALM10(LINE,DLINE)
SET LINE=LINE+1
+153 ;
+154 ; SCHEDULE IV
+155 SET DLINE=$$SETFLD^VALM1("SCH IV:",DLINE,"NAME")
+156 SET DSTMP=$SELECT(DS["4":"YES",1:"NO")
+157 SET DSTMP=DSTMP_$SELECT(DSTMP'=$GET(GETS(NDROOT_".5")):"**",1:"")
+158 SET DLINE=$$SETFLD^VALM1(DSTMP,DLINE,"DOJ/DEA VALUE")
+159 SET DLINE=$$SETFLD^VALM1($GET(GETS(NDROOT_".5")),DLINE,"LOCAL VALUE")
+160 DO SET^VALM10(LINE,DLINE)
SET LINE=LINE+1
+161 ;
+162 ; SCHEDULE V
+163 SET DLINE=$$SETFLD^VALM1("SCH V:",DLINE,"NAME")
+164 ; SCHEDULE V
SET DSTMP=$SELECT(DS["5":"YES",1:"NO")
+165 SET DSTMP=DSTMP_$SELECT(DSTMP'=$GET(GETS(NDROOT_".6")):"**",1:"")
+166 SET DLINE=$$SETFLD^VALM1(DSTMP,DLINE,"DOJ/DEA VALUE")
+167 SET DLINE=$$SETFLD^VALM1($GET(GETS(NDROOT_".6")),DLINE,"LOCAL VALUE")
+168 DO SET^VALM10(LINE,DLINE)
SET LINE=LINE+1
+169 ;
+170 SET NAME="processedDate"
SET DLINE=""
+171 SET CNAME=$SELECT($DATA(CN(NAME)):CN(NAME),1:NAME)
+172 DO DT^DILF("E",FG(NAME),.DTRESULT)
+173 if $DATA(DTRESULT(0))
SET DSTMP=$SELECT(DTRESULT(0)'=$GET(GETS(10.3)):"**",1:"")
+174 SET DLINE=$$SETFLD^VALM1(CNAME_":",DLINE,"NAME")
+175 SET DLINE=$$SETFLD^VALM1($GET(DTRESULT(0))_DSTMP,DLINE,"DOJ/DEA VALUE")
+176 SET DLINE=$$SETFLD^VALM1($GET(GETS(10.3)),DLINE,"LOCAL VALUE")
+177 DO SET^VALM10(LINE,DLINE)
SET LINE=LINE+1
+178 ;
+179 SET VALMCNT=LINE-1
+180 QUIT
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
