PXSPECAUTH ;ISL/AGP/GSN - Special Authorities APIs and RPCs ;Nov 06, 2025@13:07:01
;;1.0;PCE PATIENT CARE ENCOUNTER;**244**;Aug 12, 1996;Build 37
;
; Reference to DECODE^XLFJSON, ENCODE^XLFJSON in ICR #6682
Q
; ============================= Begin API section ===========================================
;
FINDBYNAME(NAME) ; Return the SA file ien from the NAME passed in.
Q +$O(^PXIND(820,"B",NAME,""))
;
FINDBYCODE(CODE) ; Return the SA file ien from the CODE passed in.
Q +$O(^PXIND(820,"C",CODE,"")) ;return ien
;
GETDISPLAYNAME(IEN) ; Return the SA Display name via the SA file ien passed in.
Q $$GET1^DIQ(820,IEN_",",3)
;
GETVALUE(DEF) ; Return the SA JSON field value from the Fileman value passed in.
Q $S(DEF="1":"Yes",DEF="0":"No",1:"Unanswered")
;
GETCODE(IEN) ;
Q $P($G(^PXIND(820,IEN,0)),U,2)
;
GETZERO(IEN) ; Return the entire 0 node of the SA file via ien.
Q $G(^PXIND(820,IEN,0))
;
SETARRAY(AR,FULLSTRUCT) ; Return JSON field values for the SAs optionally return the full structure of business rules.
N ACTN,CODE,EXCLUDE,HLPLN,IEN,JSONERR,NODE,PKGNAME,QQ,RR,SA,SEQ,WHENVAL
S CODE=""
F S CODE=$O(^PXIND(820,"C",CODE)) Q:CODE="" D ;Get base values
.S IEN=$O(^PXIND(820,"C",CODE,0)) Q:'IEN
.S NODE=^PXIND(820,IEN,0),SEQ=$P(NODE,U,4)
.S AR("specialAuthorityTypes",SEQ,"code")=CODE
.S AR("specialAuthorityTypes",SEQ,"disabled")=$S($P(NODE,U,8)=1:"true",1:"false")
.S AR("specialAuthorityTypes",SEQ,"id")=IEN
.S AR("specialAuthorityTypes",SEQ,"abbreviation")=$P(NODE,U,5)
.S AR("specialAuthorityTypes",SEQ,"displayName")=$P(NODE,U,3)
.S AR("specialAuthorityTypes",SEQ,"sequence")=SEQ
.S AR("specialAuthorityTypes",SEQ,"default")=$$GETVALUE($P(NODE,U,7))
.I '+$G(FULLSTRUCT) Q
.S HLPLN=0
.F S HLPLN=$O(^PXIND(820,IEN,3,HLPLN)) Q:'HLPLN D ;Get Help lines
..S AR("specialAuthorityTypes",SEQ,"description","\",HLPLN)=^PXIND(820,IEN,3,HLPLN,0)_$C(13)_$C(10)
.S QQ=0
.F QQ=0:0 S QQ=$O(^PXIND(820,IEN,2,QQ)) Q:'QQ D ;Get the whenValueIs value for SAs
..S WHENVAL=$$GET1^DIQ(820.02,QQ_","_IEN_",",.01)
..S AR("specialAuthorityTypes",SEQ,"valueChangeActions",QQ,"whenValueIs")=WHENVAL
..S RR=0
..F S RR=$O(^PXIND(820,IEN,2,QQ,1,RR)) Q:'RR D ;Get the actions to perform on the linked SAs
...S ACTN=$$GET1^DIQ(820.021,RR_","_QQ_","_IEN_",",.01)
...S AR("specialAuthorityTypes",SEQ,"valueChangeActions",QQ,"actions",RR)=ACTN
..S RR=0
..F S RR=$O(^PXIND(820,IEN,2,QQ,2,RR)) Q:'RR D ;Get linked SAs
...S SA=$$GET1^DIQ(820.022,RR_","_QQ_","_IEN_",",.01,"I"),SA=$$GET1^DIQ(820,SA,2) ;linked SA abbr code
...S AR("specialAuthorityTypes",SEQ,"valueChangeActions",QQ,"linkedSpecialAuthorities",RR)=SA
.S QQ=0
.F S QQ=$O(^PXIND(820,IEN,1,QQ)) Q:'QQ D ;Get Package name and exclusion flag
..S PKGNAME=$$GET1^DIQ(820.01,QQ_","_IEN_",",.01)
..S EXCLUDE=$$GET1^DIQ(820.01,QQ_","_IEN_",",1,"I"),EXCLUDE=$S(EXCLUDE="1":"true",1:"false")
..S AR("specialAuthorityTypes",SEQ,"package",QQ,"name")=PKGNAME
..S AR("specialAuthorityTypes",SEQ,"package",QQ,"excluded")=EXCLUDE
Q
;
GETSADEF(RESULTS,INPUTS) ; Get SAs for a patient per Location and/or Visit
N CAVALUE,CODE,DFN,DATETIME,LOADSTRUCT,LOC,NODE,SEQMAP,SPECAUTH,VST
S DFN=+$G(INPUTS("patientId")),DATETIME=$G(INPUTS("dateTime"))
S LOADSTRUCT=$S($G(INPUTS("loadStructure"))="true":1,1:0)
S LOC=+$G(INPUTS("location")),VST=+$G(INPUTS("visitIen"))
D SETARRAY(.SPECAUTH,LOADSTRUCT)
M SEQMAP=SPECAUTH("specialAuthorityTypes")
N AR,CNT,SEQ
;
D GETPATSA(DFN,DATETIME,LOC,VST,.AR) ;get patient specific SA indicators
;
S SEQ=0,CNT=0 F S SEQ=$O(SEQMAP(SEQ)) Q:SEQ'>0 D
.S CNT=CNT+1
.I LOADSTRUCT M RESULTS("specialAuthority",CNT)=SEQMAP(SEQ)
.I 'LOADSTRUCT D
..S RESULTS("specialAuthority",CNT,"code")=SEQMAP(SEQ,"code")
..S RESULTS("specialAuthority",CNT,"visible")="false"
..S RESULTS("specialAuthority",CNT,"default")=SEQMAP(SEQ,"default")
.I '$D(AR(SEQMAP(SEQ,"code"))) Q
.I SEQMAP(SEQ,"disabled")="true" Q
.S NODE=$G(AR(SEQMAP(SEQ,"code")))
.I $P(NODE,U)=1 S RESULTS("specialAuthority",CNT,"visible")="true"
.I $P(NODE,U,2)=0 S RESULTS("specialAuthority",CNT,"default")="no"
.I $P(NODE,U,2)=1 S RESULTS("specialAuthority",CNT,"default")="yes"
I $G(INPUTS("returnSequenceMap"))="true" M RESULTS("sequenceMap")=SEQMAP
Q
;
GETPATSA(DFN,ATM,LOC,VST,PXARRAY) ;Get the patients SA indicators
N CODE,DATE,INSTDT,NODE0,ORGSA,PCELOC,SCVAL
;S PCELOC=+$$GET^XPAR("ALL","PX SA USE LOC FOR ENCOUNTERS") ;Location feature switch for PCE
;S:'PCELOC LOC=""
D SCCOND^PXUTLSCC(DFN,ATM,+$G(LOC),+$G(VST),.PXARRAY) I +$G(VST)=0 Q
D GETSAFORVISIT(.ORGSA,VST)
S CODE="" F S CODE=$O(PXARRAY(CODE)) Q:CODE="" D
.I $G(ORGSA(CODE))=""!($G(ORGSA(CODE))=-1) Q
.S PXARRAY(CODE)=1_U_ORGSA(CODE)
S SCVAL=$G(PXARRAY("SC")) I +SCVAL=0!($P(SCVAL,U,2)=0) Q
I '$$INSTALDT^XPDUTL("PX*1.0*244",.INSTDT) Q
S DATE=$O(INSTDT("")) I DATE'>0 Q
S NODE0=$G(^AUPNVSIT(VST,0)) I +$P(NODE0,U)=0 Q
I $$FMDIFF^XLFDT(DATE,$P(NODE0,U),2)<1 Q
S PXARRAY("AO")=0,PXARRAY("IR")=0,PXARRAY("EC")=0
Q
;
ISACTIVECODE(CODE) ;
N IDX
S IDX=+$O(^PXIND(820,"C",CODE,"")) I IDX'>0 Q 0
I +$P($G(^PXIND(820,IDX,0)),U,8)=1 Q 0
Q 1
;
;; ============================= End API section ===========================================
;
BLDFDA(FDA,IEN,SAS,ISVPOV) ;
;If called from DATA2PCE API SAS format is SAS("AO")=1/0
;If called from ListManager Check out SAS format is SAS(1)="2;AO^1/0"
N FN,ID,IDX,IENS,NODE,SAIDX,VALUE,X
S FN=$S(ISVPOV:9000010.08,1:9000010.01)
S IDX=0 F S IDX=$O(SAS(IDX)) Q:IDX'>0 D
.S NODE=SAS(IDX,0),ID=+$P(NODE,U),VALUE=$P(NODE,U,2) I ID=0 Q
.S SAIDX=$S(ISVPOV:+$O(^AUPNVPOV(IEN,900,"B",ID,"")),1:+$O(^AUPNVSIT(IEN,900,"B",ID,"")))
.I SAIDX=0 S SAIDX=$$SETNEWSA(IEN,ID,ISVPOV) I 'SAIDX Q
.S IENS=SAIDX_","_IEN_","
.S FDA(FN,IENS,.01)=ID
.S FDA(FN,IENS,1)=$S(VALUE'="":VALUE,1:-1)
I $D(FDA),'ISVPOV D
.F X=80001:1:80008 S FDA(9000010,IEN_",",X)="@"
.F X=80011:1:80018 S FDA(9000010,IEN_",",X)="@"
Q
;
;BLDFDAENTRY(FDA,ID,VISIT,VALUE) ;
;N IDX,IENS
;S IDX=+$O(^AUPNVSIT(VISIT,900,"B",ID,""))
;I IDX=0 S IDX=$$SETNEWSA(VISIT,ID) I 'IDX Q
;I IDX>0 S IENS=IDX_","_VISIT_","
;S FDA(9000010.01,IENS,.01)=ID
;S FDA(9000010.01,IENS,1)=$S(VALUE'="":VALUE,1:"@")
;Q
;
CONVERTTOPCE(RESULTS,SAS) ;
N CNT,CODE,ID
S CNT=0,CODE="" F S CODE=$O(SAS(CODE)) Q:CODE="" D
.S ID=+$O(^PXIND(820,"C",CODE,"")) I ID=0 Q
.S CNT=CNT+1,RESULTS(CNT,0)=ID_U_SAS(CODE)
S RESULTS=$S(CNT>0:CNT,1:"")
Q
;
GETSAFORVISITDET(NODE900,NODE800,VISIT) ;
N TEMP
D GETSAFORVISIT(.TEMP,VISIT)
D SETOLD800(.NODE800,.TEMP,0)
D CONVERTTOPCE(.NODE900,.TEMP)
Q
;
GETSAFORVISIT(RESULTS,VISIT) ;
N CODE,DATE,IDX,INSTDT,NODE,X
S IDX=0 F S IDX=$O(^AUPNVSIT(VISIT,900,IDX)) Q:IDX'>0 D
.S NODE=$G(^AUPNVSIT(VISIT,900,IDX,0)) I +$P(NODE,U)=0 Q
.S CODE=$P($G(^PXIND(820,$P(NODE,U),0)),U,2) I CODE="" Q
.S RESULTS(CODE)=$P(NODE,U,2)
I $D(RESULTS) Q
S NODE=$G(^AUPNVSIT(VISIT,800))
F X=1:1:8 D
.S CODE=$$NODETOCODE(X) I CODE="" Q
.I $P(NODE,U,X)="",+$P(NODE,U,(X+10))=0 Q
.S RESULTS(CODE)=$P(NODE,U,X)
I '$D(RESULTS) Q
S SCVAL=$G(RESULTS("SC")) I +SCVAL=0!($P(SCVAL,U,2)=0) Q
;S INSTDT(DT)=1
I '$$INSTALDT^XPDUTL("PX*1.0*244",.INSTDT) Q
S DATE=$O(INSTDT("")) I DATE'>0 Q
S NODE0=$G(^AUPNVSIT(VISIT,0)) I +$P(NODE0,U)=0 Q
I $$FMDIFF^XLFDT(DATE,$P(NODE0,U),2)<1 Q
K RESULTS("AO"),RESULTS("IR"),RESULTS("EC")
Q
;
GETSAFORVPOVDET(NODE900,NODE800,VPOV) ;
N TEMP
D GETSAFORVPOV(.TEMP,VPOV)
D SETOLD800(.NODE800,.TEMP,1)
D CONVERTTOPCE(.NODE900,.TEMP)
Q
;
GETSAFORVPOV(RESULTS,VPOV) ;
N CODE,FOUND,IDX,NODE,X
S IDX=0,FOUND=0 F S IDX=$O(^AUPNVPOV(VPOV,900,IDX)) Q:IDX'>0 D
.S NODE=$G(^AUPNVPOV(VPOV,900,IDX,0)) I +$P(NODE,U)=0 Q
.S CODE=$P($G(^PXIND(820,$P(NODE,U),0)),U,2) I CODE="" Q
.S RESULTS(CODE)=$P(NODE,U,2) I +$P(NODE,U,2)>-1 S FOUND=1
I $D(RESULTS),FOUND=1 Q
S NODE=$G(^AUPNVPOV(VPOV,800))
F X=1:1:8 D
.S CODE=$$NODETOCODE(X) I CODE="" Q
.I $P(NODE,U,X)="" Q
.S RESULTS(CODE)=$P(NODE,U,X)
Q
;
SAVALUEFORVISIT(VISIT,CODE) ;
N SAS
D GETSAFORVISIT(.SAS,VISIT)
Q $G(SAS(CODE))
;
SETOLD800(RESULT,SAS,ISVPOV) ;
N PIECE,CODE
S RESULT=$S(+$G(ISVPOV):"^^^^^^^",1:"^^^^^^^^^^^^^^^^^")
I '$D(SAS) Q
S CODE="" F S CODE=$O(SAS(CODE)) Q:CODE="" D
.S PIECE=$$SCMAP(CODE) I PIECE=0 Q
.S $P(RESULT,U,PIECE)=$S(SAS(CODE)>-1:SAS(CODE),1:"") I ISVPOV Q
.S $P(RESULT,U,(PIECE+10))=0
Q
;
UPDATEROMVISIT(PXARRAY,VST) ;
N NODE,PIECE,SA,TMP,VALUE
S NODE=$G(^AUPNVSIT(VST,800))
S SA="" F S SA=$O(PXARRAY(SA)) Q:SA="" D
.S PIECE=$$SCMAP(SA) I PIECE=0 Q
.S VALUE=$P(NODE,U,PIECE),TMP=PXARRAY(SA) I VALUE="" Q
.I SA="AO"!(SA="IR")!(SA="EC") S TMP=1_U_VALUE S PXARRAY(SA)=TMP Q
Q
;
NODETOCODE(J) ;
I J=1 Q "SC"
I J=2 Q "AO"
I J=3 Q "IR"
I J=4 Q "EC"
I J=5 Q "MST"
I J=6 Q "HNC"
I J=7 Q "CV"
I J=8 Q "SHAD"
Q ""
;
SCMAP(J) ;
I $G(J)="" Q 0
I J="SC" Q 1
I J="AO" Q 2
I J="IR" Q 3
I J="EC" Q 4
I J="MST" Q 5
I J="HNC" Q 6
I J="CV" Q 7
I J="SHAD" Q 8
Q 0
;
SETVALUE(VALUE) ;
Q $S(VALUE="Yes":1,VALUE="No":0,1:"")
;
SETNEWSA(IEN,SA,ISVPOV) ;
N DA,DIC,X,Y
S DIC(0)="F",DA(1)=IEN
S DIC=$S(ISVPOV:"^AUPNVPOV(",1:"^AUPNVSIT(")_DA(1)_",900,",X=SA
D FILE^DICN
Q +$G(Y)
;
; ============================ Begin RPC section ===========================================
SPECAUTHSTRUCT(RESULTS) ;Return valid Special Authorities (SA) rules structure defined in file #820.
; Input: None.
; Output: RESULTS = JSON elements: {code}:internal abbr,{abbreviation}:external abbr code,{displayName}:Name,{sequence}:display sequence,{default}:Yes/No/Unanswered
; {whenValueIs}:value this SA code,{actions}:action to take on a linked SA code,{linkedSpecialAuthorities}:a linked SA code
N AR,JSONERR
D SETARRAY(.AR,1)
D ENCODE^XLFJSON("AR","RESULTS","JSONERR")
Q
;
SPECAUTHDEF(RESULTS,JSONIN) ;Return Patient Special Authorities (SA) that may be selected via a JSON serialized string. *508
; Input: JSONIN = JSON elements: {patientId}:orig DFN, {dateTime}:orig ATM, {location}:orig LOC, {visitIen}:orig VST,
; {loadStructure}:true/false value (optional); Load SAs rules structure
; Output: RESULTS = JSON elements: {code}: internal abbr,{visible}:true/false,{default}:Yes/No/Unanswered
;
N AR,ERR,PARAM
I '$D(JSONIN) D Q
. S ERR("success")="false",ERR("error")="Missing 1 or more parameter elements"
. D ENCODE^XLFJSON("ERR","RESULTS","JSONERR")
D DECODE^XLFJSON("JSONIN","PARAM","JSONERR")
D GETSADEF(.AR,.PARAM)
S AR("success")="true"
D ENCODE^XLFJSON("AR","RESULTS","JSONERR")
Q
;
; ============================ End RPC section ===========================================
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXSPECAUTH 11112 printed May 25, 2026@12:35:15 Page 2
PXSPECAUTH ;ISL/AGP/GSN - Special Authorities APIs and RPCs ;Nov 06, 2025@13:07:01
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**244**;Aug 12, 1996;Build 37
+2 ;
+3 ; Reference to DECODE^XLFJSON, ENCODE^XLFJSON in ICR #6682
+4 QUIT
+5 ; ============================= Begin API section ===========================================
+6 ;
FINDBYNAME(NAME) ; Return the SA file ien from the NAME passed in.
+1 QUIT +$ORDER(^PXIND(820,"B",NAME,""))
+2 ;
FINDBYCODE(CODE) ; Return the SA file ien from the CODE passed in.
+1 ;return ien
QUIT +$ORDER(^PXIND(820,"C",CODE,""))
+2 ;
GETDISPLAYNAME(IEN) ; Return the SA Display name via the SA file ien passed in.
+1 QUIT $$GET1^DIQ(820,IEN_",",3)
+2 ;
GETVALUE(DEF) ; Return the SA JSON field value from the Fileman value passed in.
+1 QUIT $SELECT(DEF="1":"Yes",DEF="0":"No",1:"Unanswered")
+2 ;
GETCODE(IEN) ;
+1 QUIT $PIECE($GET(^PXIND(820,IEN,0)),U,2)
+2 ;
GETZERO(IEN) ; Return the entire 0 node of the SA file via ien.
+1 QUIT $GET(^PXIND(820,IEN,0))
+2 ;
SETARRAY(AR,FULLSTRUCT) ; Return JSON field values for the SAs optionally return the full structure of business rules.
+1 NEW ACTN,CODE,EXCLUDE,HLPLN,IEN,JSONERR,NODE,PKGNAME,QQ,RR,SA,SEQ,WHENVAL
+2 SET CODE=""
+3 ;Get base values
FOR
SET CODE=$ORDER(^PXIND(820,"C",CODE))
if CODE=""
QUIT
Begin DoDot:1
+4 SET IEN=$ORDER(^PXIND(820,"C",CODE,0))
if 'IEN
QUIT
+5 SET NODE=^PXIND(820,IEN,0)
SET SEQ=$PIECE(NODE,U,4)
+6 SET AR("specialAuthorityTypes",SEQ,"code")=CODE
+7 SET AR("specialAuthorityTypes",SEQ,"disabled")=$SELECT($PIECE(NODE,U,8)=1:"true",1:"false")
+8 SET AR("specialAuthorityTypes",SEQ,"id")=IEN
+9 SET AR("specialAuthorityTypes",SEQ,"abbreviation")=$PIECE(NODE,U,5)
+10 SET AR("specialAuthorityTypes",SEQ,"displayName")=$PIECE(NODE,U,3)
+11 SET AR("specialAuthorityTypes",SEQ,"sequence")=SEQ
+12 SET AR("specialAuthorityTypes",SEQ,"default")=$$GETVALUE($PIECE(NODE,U,7))
+13 IF '+$GET(FULLSTRUCT)
QUIT
+14 SET HLPLN=0
+15 ;Get Help lines
FOR
SET HLPLN=$ORDER(^PXIND(820,IEN,3,HLPLN))
if 'HLPLN
QUIT
Begin DoDot:2
+16 SET AR("specialAuthorityTypes",SEQ,"description","\",HLPLN)=^PXIND(820,IEN,3,HLPLN,0)_$CHAR(13)_$CHAR(10)
End DoDot:2
+17 SET QQ=0
+18 ;Get the whenValueIs value for SAs
FOR QQ=0:0
SET QQ=$ORDER(^PXIND(820,IEN,2,QQ))
if 'QQ
QUIT
Begin DoDot:2
+19 SET WHENVAL=$$GET1^DIQ(820.02,QQ_","_IEN_",",.01)
+20 SET AR("specialAuthorityTypes",SEQ,"valueChangeActions",QQ,"whenValueIs")=WHENVAL
+21 SET RR=0
+22 ;Get the actions to perform on the linked SAs
FOR
SET RR=$ORDER(^PXIND(820,IEN,2,QQ,1,RR))
if 'RR
QUIT
Begin DoDot:3
+23 SET ACTN=$$GET1^DIQ(820.021,RR_","_QQ_","_IEN_",",.01)
+24 SET AR("specialAuthorityTypes",SEQ,"valueChangeActions",QQ,"actions",RR)=ACTN
End DoDot:3
+25 SET RR=0
+26 ;Get linked SAs
FOR
SET RR=$ORDER(^PXIND(820,IEN,2,QQ,2,RR))
if 'RR
QUIT
Begin DoDot:3
+27 ;linked SA abbr code
SET SA=$$GET1^DIQ(820.022,RR_","_QQ_","_IEN_",",.01,"I")
SET SA=$$GET1^DIQ(820,SA,2)
+28 SET AR("specialAuthorityTypes",SEQ,"valueChangeActions",QQ,"linkedSpecialAuthorities",RR)=SA
End DoDot:3
End DoDot:2
+29 SET QQ=0
+30 ;Get Package name and exclusion flag
FOR
SET QQ=$ORDER(^PXIND(820,IEN,1,QQ))
if 'QQ
QUIT
Begin DoDot:2
+31 SET PKGNAME=$$GET1^DIQ(820.01,QQ_","_IEN_",",.01)
+32 SET EXCLUDE=$$GET1^DIQ(820.01,QQ_","_IEN_",",1,"I")
SET EXCLUDE=$SELECT(EXCLUDE="1":"true",1:"false")
+33 SET AR("specialAuthorityTypes",SEQ,"package",QQ,"name")=PKGNAME
+34 SET AR("specialAuthorityTypes",SEQ,"package",QQ,"excluded")=EXCLUDE
End DoDot:2
End DoDot:1
+35 QUIT
+36 ;
GETSADEF(RESULTS,INPUTS) ; Get SAs for a patient per Location and/or Visit
+1 NEW CAVALUE,CODE,DFN,DATETIME,LOADSTRUCT,LOC,NODE,SEQMAP,SPECAUTH,VST
+2 SET DFN=+$GET(INPUTS("patientId"))
SET DATETIME=$GET(INPUTS("dateTime"))
+3 SET LOADSTRUCT=$SELECT($GET(INPUTS("loadStructure"))="true":1,1:0)
+4 SET LOC=+$GET(INPUTS("location"))
SET VST=+$GET(INPUTS("visitIen"))
+5 DO SETARRAY(.SPECAUTH,LOADSTRUCT)
+6 MERGE SEQMAP=SPECAUTH("specialAuthorityTypes")
+7 NEW AR,CNT,SEQ
+8 ;
+9 ;get patient specific SA indicators
DO GETPATSA(DFN,DATETIME,LOC,VST,.AR)
+10 ;
+11 SET SEQ=0
SET CNT=0
FOR
SET SEQ=$ORDER(SEQMAP(SEQ))
if SEQ'>0
QUIT
Begin DoDot:1
+12 SET CNT=CNT+1
+13 IF LOADSTRUCT
MERGE RESULTS("specialAuthority",CNT)=SEQMAP(SEQ)
+14 IF 'LOADSTRUCT
Begin DoDot:2
+15 SET RESULTS("specialAuthority",CNT,"code")=SEQMAP(SEQ,"code")
+16 SET RESULTS("specialAuthority",CNT,"visible")="false"
+17 SET RESULTS("specialAuthority",CNT,"default")=SEQMAP(SEQ,"default")
End DoDot:2
+18 IF '$DATA(AR(SEQMAP(SEQ,"code")))
QUIT
+19 IF SEQMAP(SEQ,"disabled")="true"
QUIT
+20 SET NODE=$GET(AR(SEQMAP(SEQ,"code")))
+21 IF $PIECE(NODE,U)=1
SET RESULTS("specialAuthority",CNT,"visible")="true"
+22 IF $PIECE(NODE,U,2)=0
SET RESULTS("specialAuthority",CNT,"default")="no"
+23 IF $PIECE(NODE,U,2)=1
SET RESULTS("specialAuthority",CNT,"default")="yes"
End DoDot:1
+24 IF $GET(INPUTS("returnSequenceMap"))="true"
MERGE RESULTS("sequenceMap")=SEQMAP
+25 QUIT
+26 ;
GETPATSA(DFN,ATM,LOC,VST,PXARRAY) ;Get the patients SA indicators
+1 NEW CODE,DATE,INSTDT,NODE0,ORGSA,PCELOC,SCVAL
+2 ;S PCELOC=+$$GET^XPAR("ALL","PX SA USE LOC FOR ENCOUNTERS") ;Location feature switch for PCE
+3 ;S:'PCELOC LOC=""
+4 DO SCCOND^PXUTLSCC(DFN,ATM,+$GET(LOC),+$GET(VST),.PXARRAY)
IF +$GET(VST)=0
QUIT
+5 DO GETSAFORVISIT(.ORGSA,VST)
+6 SET CODE=""
FOR
SET CODE=$ORDER(PXARRAY(CODE))
if CODE=""
QUIT
Begin DoDot:1
+7 IF $GET(ORGSA(CODE))=""!($GET(ORGSA(CODE))=-1)
QUIT
+8 SET PXARRAY(CODE)=1_U_ORGSA(CODE)
End DoDot:1
+9 SET SCVAL=$GET(PXARRAY("SC"))
IF +SCVAL=0!($PIECE(SCVAL,U,2)=0)
QUIT
+10 IF '$$INSTALDT^XPDUTL("PX*1.0*244",.INSTDT)
QUIT
+11 SET DATE=$ORDER(INSTDT(""))
IF DATE'>0
QUIT
+12 SET NODE0=$GET(^AUPNVSIT(VST,0))
IF +$PIECE(NODE0,U)=0
QUIT
+13 IF $$FMDIFF^XLFDT(DATE,$PIECE(NODE0,U),2)<1
QUIT
+14 SET PXARRAY("AO")=0
SET PXARRAY("IR")=0
SET PXARRAY("EC")=0
+15 QUIT
+16 ;
ISACTIVECODE(CODE) ;
+1 NEW IDX
+2 SET IDX=+$ORDER(^PXIND(820,"C",CODE,""))
IF IDX'>0
QUIT 0
+3 IF +$PIECE($GET(^PXIND(820,IDX,0)),U,8)=1
QUIT 0
+4 QUIT 1
+5 ;
+6 ;; ============================= End API section ===========================================
+7 ;
BLDFDA(FDA,IEN,SAS,ISVPOV) ;
+1 ;If called from DATA2PCE API SAS format is SAS("AO")=1/0
+2 ;If called from ListManager Check out SAS format is SAS(1)="2;AO^1/0"
+3 NEW FN,ID,IDX,IENS,NODE,SAIDX,VALUE,X
+4 SET FN=$SELECT(ISVPOV:9000010.08,1:9000010.01)
+5 SET IDX=0
FOR
SET IDX=$ORDER(SAS(IDX))
if IDX'>0
QUIT
Begin DoDot:1
+6 SET NODE=SAS(IDX,0)
SET ID=+$PIECE(NODE,U)
SET VALUE=$PIECE(NODE,U,2)
IF ID=0
QUIT
+7 SET SAIDX=$SELECT(ISVPOV:+$ORDER(^AUPNVPOV(IEN,900,"B",ID,"")),1:+$ORDER(^AUPNVSIT(IEN,900,"B",ID,"")))
+8 IF SAIDX=0
SET SAIDX=$$SETNEWSA(IEN,ID,ISVPOV)
IF 'SAIDX
QUIT
+9 SET IENS=SAIDX_","_IEN_","
+10 SET FDA(FN,IENS,.01)=ID
+11 SET FDA(FN,IENS,1)=$SELECT(VALUE'="":VALUE,1:-1)
End DoDot:1
+12 IF $DATA(FDA)
IF 'ISVPOV
Begin DoDot:1
+13 FOR X=80001:1:80008
SET FDA(9000010,IEN_",",X)="@"
+14 FOR X=80011:1:80018
SET FDA(9000010,IEN_",",X)="@"
End DoDot:1
+15 QUIT
+16 ;
+17 ;BLDFDAENTRY(FDA,ID,VISIT,VALUE) ;
+18 ;N IDX,IENS
+19 ;S IDX=+$O(^AUPNVSIT(VISIT,900,"B",ID,""))
+20 ;I IDX=0 S IDX=$$SETNEWSA(VISIT,ID) I 'IDX Q
+21 ;I IDX>0 S IENS=IDX_","_VISIT_","
+22 ;S FDA(9000010.01,IENS,.01)=ID
+23 ;S FDA(9000010.01,IENS,1)=$S(VALUE'="":VALUE,1:"@")
+24 ;Q
+25 ;
CONVERTTOPCE(RESULTS,SAS) ;
+1 NEW CNT,CODE,ID
+2 SET CNT=0
SET CODE=""
FOR
SET CODE=$ORDER(SAS(CODE))
if CODE=""
QUIT
Begin DoDot:1
+3 SET ID=+$ORDER(^PXIND(820,"C",CODE,""))
IF ID=0
QUIT
+4 SET CNT=CNT+1
SET RESULTS(CNT,0)=ID_U_SAS(CODE)
End DoDot:1
+5 SET RESULTS=$SELECT(CNT>0:CNT,1:"")
+6 QUIT
+7 ;
GETSAFORVISITDET(NODE900,NODE800,VISIT) ;
+1 NEW TEMP
+2 DO GETSAFORVISIT(.TEMP,VISIT)
+3 DO SETOLD800(.NODE800,.TEMP,0)
+4 DO CONVERTTOPCE(.NODE900,.TEMP)
+5 QUIT
+6 ;
GETSAFORVISIT(RESULTS,VISIT) ;
+1 NEW CODE,DATE,IDX,INSTDT,NODE,X
+2 SET IDX=0
FOR
SET IDX=$ORDER(^AUPNVSIT(VISIT,900,IDX))
if IDX'>0
QUIT
Begin DoDot:1
+3 SET NODE=$GET(^AUPNVSIT(VISIT,900,IDX,0))
IF +$PIECE(NODE,U)=0
QUIT
+4 SET CODE=$PIECE($GET(^PXIND(820,$PIECE(NODE,U),0)),U,2)
IF CODE=""
QUIT
+5 SET RESULTS(CODE)=$PIECE(NODE,U,2)
End DoDot:1
+6 IF $DATA(RESULTS)
QUIT
+7 SET NODE=$GET(^AUPNVSIT(VISIT,800))
+8 FOR X=1:1:8
Begin DoDot:1
+9 SET CODE=$$NODETOCODE(X)
IF CODE=""
QUIT
+10 IF $PIECE(NODE,U,X)=""
IF +$PIECE(NODE,U,(X+10))=0
QUIT
+11 SET RESULTS(CODE)=$PIECE(NODE,U,X)
End DoDot:1
+12 IF '$DATA(RESULTS)
QUIT
+13 SET SCVAL=$GET(RESULTS("SC"))
IF +SCVAL=0!($PIECE(SCVAL,U,2)=0)
QUIT
+14 ;S INSTDT(DT)=1
+15 IF '$$INSTALDT^XPDUTL("PX*1.0*244",.INSTDT)
QUIT
+16 SET DATE=$ORDER(INSTDT(""))
IF DATE'>0
QUIT
+17 SET NODE0=$GET(^AUPNVSIT(VISIT,0))
IF +$PIECE(NODE0,U)=0
QUIT
+18 IF $$FMDIFF^XLFDT(DATE,$PIECE(NODE0,U),2)<1
QUIT
+19 KILL RESULTS("AO"),RESULTS("IR"),RESULTS("EC")
+20 QUIT
+21 ;
GETSAFORVPOVDET(NODE900,NODE800,VPOV) ;
+1 NEW TEMP
+2 DO GETSAFORVPOV(.TEMP,VPOV)
+3 DO SETOLD800(.NODE800,.TEMP,1)
+4 DO CONVERTTOPCE(.NODE900,.TEMP)
+5 QUIT
+6 ;
GETSAFORVPOV(RESULTS,VPOV) ;
+1 NEW CODE,FOUND,IDX,NODE,X
+2 SET IDX=0
SET FOUND=0
FOR
SET IDX=$ORDER(^AUPNVPOV(VPOV,900,IDX))
if IDX'>0
QUIT
Begin DoDot:1
+3 SET NODE=$GET(^AUPNVPOV(VPOV,900,IDX,0))
IF +$PIECE(NODE,U)=0
QUIT
+4 SET CODE=$PIECE($GET(^PXIND(820,$PIECE(NODE,U),0)),U,2)
IF CODE=""
QUIT
+5 SET RESULTS(CODE)=$PIECE(NODE,U,2)
IF +$PIECE(NODE,U,2)>-1
SET FOUND=1
End DoDot:1
+6 IF $DATA(RESULTS)
IF FOUND=1
QUIT
+7 SET NODE=$GET(^AUPNVPOV(VPOV,800))
+8 FOR X=1:1:8
Begin DoDot:1
+9 SET CODE=$$NODETOCODE(X)
IF CODE=""
QUIT
+10 IF $PIECE(NODE,U,X)=""
QUIT
+11 SET RESULTS(CODE)=$PIECE(NODE,U,X)
End DoDot:1
+12 QUIT
+13 ;
SAVALUEFORVISIT(VISIT,CODE) ;
+1 NEW SAS
+2 DO GETSAFORVISIT(.SAS,VISIT)
+3 QUIT $GET(SAS(CODE))
+4 ;
SETOLD800(RESULT,SAS,ISVPOV) ;
+1 NEW PIECE,CODE
+2 SET RESULT=$SELECT(+$GET(ISVPOV):"^^^^^^^",1:"^^^^^^^^^^^^^^^^^")
+3 IF '$DATA(SAS)
QUIT
+4 SET CODE=""
FOR
SET CODE=$ORDER(SAS(CODE))
if CODE=""
QUIT
Begin DoDot:1
+5 SET PIECE=$$SCMAP(CODE)
IF PIECE=0
QUIT
+6 SET $PIECE(RESULT,U,PIECE)=$SELECT(SAS(CODE)>-1:SAS(CODE),1:"")
IF ISVPOV
QUIT
+7 SET $PIECE(RESULT,U,(PIECE+10))=0
End DoDot:1
+8 QUIT
+9 ;
UPDATEROMVISIT(PXARRAY,VST) ;
+1 NEW NODE,PIECE,SA,TMP,VALUE
+2 SET NODE=$GET(^AUPNVSIT(VST,800))
+3 SET SA=""
FOR
SET SA=$ORDER(PXARRAY(SA))
if SA=""
QUIT
Begin DoDot:1
+4 SET PIECE=$$SCMAP(SA)
IF PIECE=0
QUIT
+5 SET VALUE=$PIECE(NODE,U,PIECE)
SET TMP=PXARRAY(SA)
IF VALUE=""
QUIT
+6 IF SA="AO"!(SA="IR")!(SA="EC")
SET TMP=1_U_VALUE
SET PXARRAY(SA)=TMP
QUIT
End DoDot:1
+7 QUIT
+8 ;
NODETOCODE(J) ;
+1 IF J=1
QUIT "SC"
+2 IF J=2
QUIT "AO"
+3 IF J=3
QUIT "IR"
+4 IF J=4
QUIT "EC"
+5 IF J=5
QUIT "MST"
+6 IF J=6
QUIT "HNC"
+7 IF J=7
QUIT "CV"
+8 IF J=8
QUIT "SHAD"
+9 QUIT ""
+10 ;
SCMAP(J) ;
+1 IF $GET(J)=""
QUIT 0
+2 IF J="SC"
QUIT 1
+3 IF J="AO"
QUIT 2
+4 IF J="IR"
QUIT 3
+5 IF J="EC"
QUIT 4
+6 IF J="MST"
QUIT 5
+7 IF J="HNC"
QUIT 6
+8 IF J="CV"
QUIT 7
+9 IF J="SHAD"
QUIT 8
+10 QUIT 0
+11 ;
SETVALUE(VALUE) ;
+1 QUIT $SELECT(VALUE="Yes":1,VALUE="No":0,1:"")
+2 ;
SETNEWSA(IEN,SA,ISVPOV) ;
+1 NEW DA,DIC,X,Y
+2 SET DIC(0)="F"
SET DA(1)=IEN
+3 SET DIC=$SELECT(ISVPOV:"^AUPNVPOV(",1:"^AUPNVSIT(")_DA(1)_",900,"
SET X=SA
+4 DO FILE^DICN
+5 QUIT +$GET(Y)
+6 ;
+7 ; ============================ Begin RPC section ===========================================
SPECAUTHSTRUCT(RESULTS) ;Return valid Special Authorities (SA) rules structure defined in file #820.
+1 ; Input: None.
+2 ; Output: RESULTS = JSON elements: {code}:internal abbr,{abbreviation}:external abbr code,{displayName}:Name,{sequence}:display sequence,{default}:Yes/No/Unanswered
+3 ; {whenValueIs}:value this SA code,{actions}:action to take on a linked SA code,{linkedSpecialAuthorities}:a linked SA code
+4 NEW AR,JSONERR
+5 DO SETARRAY(.AR,1)
+6 DO ENCODE^XLFJSON("AR","RESULTS","JSONERR")
+7 QUIT
+8 ;
SPECAUTHDEF(RESULTS,JSONIN) ;Return Patient Special Authorities (SA) that may be selected via a JSON serialized string. *508
+1 ; Input: JSONIN = JSON elements: {patientId}:orig DFN, {dateTime}:orig ATM, {location}:orig LOC, {visitIen}:orig VST,
+2 ; {loadStructure}:true/false value (optional); Load SAs rules structure
+3 ; Output: RESULTS = JSON elements: {code}: internal abbr,{visible}:true/false,{default}:Yes/No/Unanswered
+4 ;
+5 NEW AR,ERR,PARAM
+6 IF '$DATA(JSONIN)
Begin DoDot:1
+7 SET ERR("success")="false"
SET ERR("error")="Missing 1 or more parameter elements"
+8 DO ENCODE^XLFJSON("ERR","RESULTS","JSONERR")
End DoDot:1
QUIT
+9 DO DECODE^XLFJSON("JSONIN","PARAM","JSONERR")
+10 DO GETSADEF(.AR,.PARAM)
+11 SET AR("success")="true"
+12 DO ENCODE^XLFJSON("AR","RESULTS","JSONERR")
+13 QUIT
+14 ;
+15 ; ============================ End RPC section ===========================================
