Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSODEAED

PSODEAED.m

Go to the documentation of this file.
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