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

PXHFSM.m

Go to the documentation of this file.
  1. PXHFSM ;SLC/PKR - Health Factor ScreenMan routines ;06/14/2022
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**211,217**;Aug 12, 1996;Build 134
  1. ;
  1. ;===============
  1. CATNDVAL(NAME) ;Name data validation for PX HF CATEGORY.
  1. I NAME="" Q
  1. N L3C,LEN
  1. S LEN=$L(NAME),L3C=$E(NAME,(LEN-2),LEN)
  1. I L3C="[C]" Q
  1. D EN^DDIOL("Category names must end with '[C]'")
  1. H 3
  1. S DDSERROR=1
  1. Q
  1. ;
  1. ;===============
  1. CODEPAOC(DA) ;Code Post-Action On Change.
  1. N CODE,CODESYS,NEWCODE,SAVEDDS
  1. S CODESYS=$$GET^DDSVAL(9999999.66,.DA,.01)
  1. S CODE=$$GET^DDSVAL(9999999.66,.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. D PUT^DDSVAL(9999999.66,.DA,1,NEWCODE)
  1. Q
  1. ;
  1. ;===============
  1. CODEPRE(DA) ;Code pre-action.
  1. N CODESYS,TEXT
  1. S CODESYS=$$GET^DDSVAL(9999999.66,.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.64,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,TEXT
  1. ;Validate measurement input.
  1. S MIN=$$GET^DDSVAL(9999999.64,IEN,220)
  1. S MAX=$$GET^DDSVAL(9999999.64,IEN,221)
  1. S MAXDEC=$$GET^DDSVAL(9999999.64,IEN,222)
  1. S UCUM=$$GET^DDSVAL(9999999.64,IEN,223)
  1. S PROMPT=$$GET^DDSVAL(9999999.64,IEN,224)
  1. S UDISPLAY=$$GET^DDSVAL(9999999.64,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 Health Factor.
  1. S CLASS=$$GET^DDSVAL(9999999.64,IEN,100,.ERROR,"I")
  1. S SIEN=$$GET^DDSVAL(9999999.64,IEN,101,.ERROR,"I")
  1. S SCLASS=$S(SIEN="":"",1:$$GET1^DIQ(811.6,SIEN,100,"I"))
  1. I (SCLASS'=""),(SCLASS'=CLASS) D Q
  1. . S TEXT="Sponsor Class is "_SCLASS_", Health Factor Class is "_CLASS_" they must match!"
  1. . D HLP^DDSUTL(.TEXT)
  1. . S DDSBR="SPONSOR",DDSERROR=1
  1. ;If the Name starts with VA- make sure the Class is National and vice versa.
  1. S NAME=$$GET^DDSVAL(9999999.64,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(^AUTTHF(D0)) Q
  1. ;If the health factor 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.64,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.64,IEN)
  1. ;Check for mappings to delete and unlink.
  1. I $D(^TMP($J,"UNLINK",9999999.64)) D MCUNLINK^PXMCLINK(9999999.64,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, the field is uneditable.
  1. I DA="" Q " "
  1. N LINKDT
  1. S LINKDT=$$GET^DDSVAL(9999999.66,.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(^AUTTHF(IEN,210,IND)) Q:IND=0 D
  1. . I $P(^AUTTHF(IEN,210,IND,0),U,2)="" Q
  1. . S IENS=IND_","_IEN_","
  1. . D UNED^DDSUTL("CODING SYSTEM","PX HF CODE MAPPINGS BLOCK",1,1,IENS)
  1. . D UNED^DDSUTL("CODE","PX HF CODE MAPPINGS BLOCK",1,1,IENS)
  1. . D UNED^DDSUTL("DELETE","PX HF CODE MAPPINGS BLOCK",1,0,IENS)
  1. Q
  1. ;
  1. ;===============
  1. NAMEVAL ;Name validation for factors entry type
  1. N L3C,LEN
  1. S LEN=$L(DDSEXT),L3C=$E(DDSEXT,(LEN-2),LEN)
  1. I L3C="[C]" D
  1. . D EN^DDIOL("Factor names cannot have an appended '[C]'.")
  1. . H 3
  1. . S DDSERROR=1
  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 ERROR,ETYPE,HASH256,OCLOG,NATOK,SHASH256
  1. S CLASS=$$GET^DDSVAL(9999999.64,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 health factors cannot be edited."
  1. . H 2
  1. . S VALMBCK="R"
  1. S CODEMAP=$S((CLASS="N")&$D(^XUSEC("PX CODE MAPPING",DUZ)):1,1:0)
  1. S ETYPE=$$GET^DDSVAL(9999999.64,IEN,.1)
  1. S DR=$S(ETYPE="C":"[PX HF CATEGORY EDIT]",CODEMAP=1:"[PX HEALTH FACTOR EDIT]",1:"[PX HEALTH FACTOR EDIT NCM]")
  1. S (DDSFILE,DIDEL)=9999999.64,DDSPARM="CS"
  1. S NEW=$G(NEW)
  1. S SHASH256=$$FILE^XLFSHAN(256,9999999.64,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.64,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(^AUTTHF(IEN)):0,1:1)
  1. I DEL D Q
  1. . D BLDLIST^PXHFMGR("PXHFL")
  1. . S VALMBCK="R"
  1. I NEW S OCLOG=1
  1. E S HASH256=$$FILE^XLFSHAN(256,9999999.64,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.65,IENS,.01)=$$NOW^XLFDT
  1. S FDA(9999999.65,IENS,1)=DUZ
  1. I NEW D
  1. . S WPTMP(1,1,1)=" Creation."
  1. . S FDA(9999999.65,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.64,DDSFILE(1)=9999999.65
  1. S DR="[PX HEALTH FACTOR CHANGE LOG]"
  1. D ^DDS
  1. D BLDLIST^PXHFMGR("PXHFL") S VALMBCK="R"
  1. Q
  1. ;
  1. ;===============
  1. N IENS
  1. I X=1 S IENS=$$IENS^DILF(.DA),^TMP($J,"UNLINK",9999999.64,IENS)=""
  1. Q
  1. ;