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

PXEXSM.m

Go to the documentation of this file.
  1. PXEXSM ;SLC/PKR - Exam ScreenMan routines ;06/14/2022
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**211,217**;Aug 12, 1996;Build 134
  1. ;
  1. ;===================================
  1. CODEPAOC(DA) ;Code Post-Action On Change.
  1. N CODE,CODESYS,IENS,NEWCODE,OLDCODE,SAVEDDS
  1. S IENS=$$IENS^DILF(.DA)
  1. S OLDCODE=$$GET1^DIQ(9999999.18,IENS,1)
  1. S CODESYS=$$GET^DDSVAL(9999999.18,.DA,.01)
  1. S CODE=$$GET^DDSVAL(9999999.18,.DA,1)
  1. ;DBIA #5746 covers kill and set of DDS.
  1. I $D(DDS) S SAVEDDS=DDS K DDS
  1. ;Call the Lexicon search.
  1. S NEWCODE=$$GETCODE^PXLEXS(CODESYS,CODE,DT,0)
  1. ;Reset the screen so ScreenMan displays properly.
  1. I $D(SAVEDDS) D
  1. . N IOAWM0,X
  1. . S DDS=SAVEDDS
  1. . S X=0 X ^%ZOSF("RM"),^%ZOSF("TYPE-AHEAD")
  1. . S X="IOAWM0" D ENDR^%ZISS W IOAWM0
  1. . D REFRESH^DDSUTL
  1. S CODE=$S(NEWCODE'="":NEWCODE,1:OLDCODE)
  1. D PUT^DDSVAL(9999999.18,.DA,1,CODE)
  1. Q
  1. ;
  1. ;===================================
  1. CODEPRE(DA) ;Code pre-action.
  1. N CODESYS,TEXT
  1. S CODESYS=$$GET^DDSVAL(9999999.18,.DA,.01)
  1. ;ICR #5679
  1. S CODESYS=$P($$CSYS^LEXU(CODESYS),U,4)
  1. S TEXT(1)="Input a search term or a "_CODESYS_" code."
  1. D EN^DDIOL(.TEXT)
  1. Q
  1. ;
  1. ;===================================
  1. DELPAOC(X,DA) ;Delete field post action on change.
  1. N IENS
  1. I X=1 S IENS=$$IENS^DILF(.DA),^TMP($J,"UNLINK",9999999.15,IENS)=""
  1. Q
  1. ;
  1. ;===================================
  1. DELPRE ;Delete field pre-action.
  1. N TEXT
  1. S TEXT(1)="Enter 'Y' if you want to delete this code mapping."
  1. S TEXT(2)="Warning - a deletion will remove all mapped source entries created"
  1. S TEXT(3)="as a result of this code mapping."
  1. D EN^DDIOL(.TEXT)
  1. Q
  1. ;
  1. ;===================================
  1. FDATAVAL(IEN) ;Form Data Validation.
  1. N CLASS,ERROR,MAX,MAXDEC,MIN,NAME,PREFIX,PROMPT
  1. N SCLASS,SIEN,UCUM,UDISPLAY,TEXT
  1. ;Validate measurement input.
  1. S MIN=$$GET^DDSVAL(9999999.15,IEN,220)
  1. S MAX=$$GET^DDSVAL(9999999.15,IEN,221)
  1. S MAXDEC=$$GET^DDSVAL(9999999.15,IEN,222)
  1. S UCUM=$$GET^DDSVAL(9999999.15,IEN,223)
  1. S PROMPT=$$GET^DDSVAL(9999999.15,IEN,224)
  1. S UDISPLAY=$$GET^DDSVAL(9999999.15,IEN,225)
  1. I (MIN=""),(MAX=""),(MAXDEC=""),(UCUM=""),(PROMPT=""),(UDISPLAY="") G SPONCLASS
  1. ;If any of the measurement fields are defined they all must be.
  1. I (MIN="")!(MAX="")!(MAXDEC="")!(UCUM="")!(PROMPT="")!(UDISPLAY="") D Q
  1. . S TEXT="If any of the measurement fields are defined, they all must be."
  1. . D HLP^DDSUTL(.TEXT)
  1. . S DDSBR="MINIMUM VALUE",DDSERROR=1
  1. I MAX<MIN D Q
  1. . S TEXT="The Maximum Value cannot be less than the Minimum Value."
  1. . D HLP^DDSUTL(.TEXT)
  1. . S DDSBR="MAXIMUM VALUE",DDSERROR=1
  1. SPONCLASS ;Make sure the Class of the Sponsor matches that of the Exam.
  1. S CLASS=$$GET^DDSVAL(9999999.15,IEN,100,.ERROR,"I")
  1. S SIEN=$$GET^DDSVAL(9999999.15,IEN,101,.ERROR,"I")
  1. S SCLASS=$S(SIEN="":"",1:$$GET1^DIQ(811.6,SIEN,100,"I"))
  1. I (SCLASS'=""),(SCLASS'=CLASS) D
  1. . S TEXT="Sponsor Class is "_SCLASS_", Exam Class is "_CLASS_" they must match!"
  1. . D HLP^DDSUTL(.TEXT)
  1. . S DDSBR="CLASS",DDSERROR=1
  1. ;If the Name starts with VA- make sure the Class is National and vice versa.
  1. S NAME=$$GET^DDSVAL(9999999.15,IEN,.01)
  1. S PREFIX=$E(NAME,1,3),TEXT=""
  1. I PREFIX="VA-",CLASS'="N" S TEXT="Name starts with 'VA-', but the Class is not National."
  1. I CLASS="N",PREFIX'="VA-" S TEXT="The Class is National but the name does not start with VA-."
  1. I TEXT'="" D
  1. . D HLP^DDSUTL(.TEXT)
  1. . S DDSBR="NAME",DDSERROR=1
  1. Q
  1. ;
  1. ;===================================
  1. FPOSTACT(IEN) ;Form Post-Action
  1. N INACTIVE,INUSE,OUTPUT
  1. ;If the change was a deletion there is nothing else to do.
  1. I '$D(^AUTTEXAM(D0)) Q
  1. ;If the exam was inactivated check to see if it is being used.
  1. ;Need a new FileMan API to do this.
  1. S INACTIVE=$$GET^DDSVAL(9999999.15,IEN,"INACTIVE FLAG")
  1. Q
  1. ;
  1. ;===================================
  1. FPOSTSAV(IEN) ;Form Post-Save.
  1. ;Check for mapped codes to link.
  1. D MCLINK^PXMCLINK(9999999.15,IEN)
  1. ;Check for mappings to delete and unlink.
  1. I $D(^TMP($J,"UNLINK",9999999.15)) D MCUNLINK^PXMCLINK(9999999.15,IEN)
  1. Q
  1. ;
  1. ;===================================
  1. FPREACT(DA) ;Form pre-action
  1. Q
  1. ;
  1. ;===================================
  1. LINKED(DA) ;This is the display for the Linked column,
  1. ;the field is uneditable.
  1. I DA="" Q " "
  1. N LINKDT
  1. S LINKDT=$$GET^DDSVAL(9999999.18,.DA,"DATE LINKED")
  1. Q $S(LINKDT'="":"Y",1:"N")
  1. ;
  1. ;===================================
  1. MCBLKPRE(DA) ;Mapped codes block pre-action.
  1. ;Make any mapped codes uneditable.
  1. N IENS,IND
  1. S IEN=DA(1),IND=0
  1. F S IND=+$O(^AUTTEXAM(IEN,210,IND)) Q:IND=0 D
  1. . I $P(^AUTTEXAM(IEN,210,IND,0),U,2)="" Q
  1. . S IENS=IND_","_IEN_","
  1. . D UNED^DDSUTL("CODING SYSTEM","PX EXAM CODE MAPPINGS BLOCK",1,1,IENS)
  1. . D UNED^DDSUTL("CODE","PX EXAM CODE MAPPINGS BLOCK",1,1,IENS)
  1. . D UNED^DDSUTL("DELETE","PX EXAM CODE MAPPINGS BLOCK",1,0,IENS)
  1. Q
  1. ;
  1. ;===================================
  1. SMANEDIT(IEN,NEW) ;ScreenMan edit for entry IEN.
  1. N CLASS,CODEMAP,DA,DDSCHANG,DDSFILE,DDSPARM,DDSSAVE,DEL,DIDEL,DIMSG,DR,DTOUT
  1. N HASH256,OCLOG,NATOK,SHASH256
  1. S CLASS=$$GET^DDSVAL(9999999.15,IEN,100,.ERROR,"I")
  1. S NATOK=$S(CLASS'="N":1,1:($G(PXNAT)=1)&($G(DUZ(0))="@"))
  1. I 'NATOK D Q
  1. . W !,"National exams cannot be edited."
  1. . H 2
  1. . S VALMBCK="R"
  1. S (DDSFILE,DIDEL)=9999999.15,DDSPARM="CS"
  1. S CODEMAP=$S((CLASS="N")&$D(^XUSEC("PX CODE MAPPING",DUZ)):1,1:0)
  1. S DR=$S(CODEMAP=1:"[PX EXAM EDIT]",1:"[PX EXAM EDIT NCM]")
  1. S NEW=$G(NEW)
  1. S SHASH256=$$FILE^XLFSHAN(256,9999999.15,IEN)
  1. S DA=IEN
  1. D ^DDS
  1. I $D(DIMSG) H 2
  1. ;If the entry is new and the user did not save, delete it.
  1. I NEW,$G(DDSSAVE)'=1 D DELFE^PXUTIL(9999999.15,IEN) Q
  1. ;If changes were made update the change log. If the change was a
  1. ;deletion skip the change log.
  1. S DEL=$S($D(^AUTTEXAM(IEN)):0,1:1)
  1. I DEL D Q
  1. . D BLDLIST^PXEXMGR("PXEXAML")
  1. . S VALMBCK="R"
  1. I NEW S OCLOG=1
  1. E S HASH256=$$FILE^XLFSHAN(256,9999999.15,IEN),OCLOG=$S(HASH256=SHASH256:0,1:1)
  1. I 'OCLOG S VALMBCK="R" Q
  1. ;Open the Change Log
  1. N IENS,FDA,FDAIEN,MSG,WPTMP
  1. S IENS="+1,"_IEN_","
  1. S FDA(9999999.16,IENS,.01)=$$NOW^XLFDT
  1. S FDA(9999999.16,IENS,1)=DUZ
  1. I NEW D
  1. . S WPTMP(1,1,1)=" Creation."
  1. . S FDA(9999999.16,IENS,2)="WPTMP(1,1)"
  1. D UPDATE^DIE("S","FDA","FDAIEN","MSG")
  1. K DA,DDSFILE
  1. S DA=FDAIEN(1),DA(1)=IEN
  1. S DDSFILE=9999999.15,DDSFILE(1)=9999999.16
  1. S DR="[PX EXAM CHANGE LOG]"
  1. D ^DDS
  1. D BLDLIST^PXEXMGR("PXEXAML") S VALMBCK="R"
  1. Q
  1. ;
  1. ;===================================
  1. N IENS
  1. I X=1 S IENS=$$IENS^DILF(.DA),^TMP($J,"UNLINK",9999999.15,IENS)=""
  1. Q
  1. ;