- ANRVOA ; HOIFO/CED - User, Patient and Parameter specifics for Patient Review. ; [01-07-2003 12:19]
- ;;4.0;VISUAL IMPAIRMENT SERVICE TEAM;**5**;AUG 21, 2003
- ADD(X) ; [Procedure] Adds to RESULTS
- S @RESULTS@(+$O(@RESULTS@(""),-1)+1)=X
- Q
- ;
- DELLST ; [Procedure] Delete list of parameters
- D NDEL^XPAR(ENT,PAR,.ERR)
- S:'$G(ERR) @RESULTS@(0)="1^All Instances Removed"
- Q
- ;
- DELPAR ; [Procedure] Delete single parameter value
- D DEL^XPAR(ENT,PAR,INST,.ERR)
- S:'$G(ERR) @RESULTS@(0)="1^Instance Deleted"
- Q
- ;
- ELECSIG ; [Procedure] Check Electronic Signature
- N X
- S X=DATA
- S X1=$S($D(DUZ)[0:"",$D(^VA(200,DUZ,20))[0:"",1:$P(^(20),U,4))
- I X1="" S @RESULTS@(0)="-1^Electronic Signature Not Found." Q
- D HASH^XUSHSHP
- I X1'=X S @RESULTS@(0)="0^Electronic Signature Incorrect." Q
- S @RESULTS@(0)="1^Electronic Signature Verified."
- Q
- ;
- ENTVAL ; [Procedure] Return value of the entity
- I ENT="SYS" S ENT=$$KSP^XUPARAM("WHERE")
- E I ENT="DIV" S ENT=$$GET1^DIQ(4,DUZ(2)_",",.01)
- E I ENT="USR" S ENT=$$GET1^DIQ(200,DUZ_",",.01)
- E S ENT=$$GET1^DIQ(+$P(ENT,"(",2),+ENT_",",.01)
- S @RESULTS@(0)=ENT
- Q
- ;
- FULLSSN(LST,ID) ; [Procedure] Return a list of patients matching Full SSN entered
- N I,IEN
- S (I,IEN)=0
- F S IEN=$O(^DPT("SSN",ID,IEN)) Q:'IEN D
- . S I=I+1,LST(I)=IEN_U_$P(^DPT(IEN,0),U)_U_$$DOB^DPTLK1(IEN,2)_U_$$SSN^DPTLK1(IEN) ; DG249
- Q
- ;
- GETHDR ; [Procedure] Returns common header format
- S X=$$FIND1^DIC(8989.51,,"QX",PAR)
- I X S @RESULTS@(0)=X_";8989.51^"_PAR
- E S @RESULTS@(0)="-1^No such parameter ["_PAR_"]"
- Q
- ;
- GETLST ; [Procedure] Return all instances of a parameter
- D GETLST^XPAR(.RET,ENT,PAR,"E",.ERR)
- Q:$G(ERR,0)
- S TMP="RET"
- F S TMP=$Q(@TMP) Q:TMP="" D
- .S @RESULTS@($O(@RESULTS@(""),-1)+1)=@TMP
- S @RESULTS@(0)=$O(@RESULTS@(""),-1)
- Q
- ;
- GETPAR ; [Procedure] Returns external value for a parameter
- S @RESULTS@(0)=$$GET^XPAR(ENT,PAR,INST,"E")
- Q
- ;
- GETWP ; [Procedure] Returns WP text for a parameter
- D GETWP^XPAR(.RET,ENT,PAR,INST,.ERR)
- Q:$G(ERR,0)
- S TMP="RET"
- F S TMP=$Q(@TMP) Q:TMP="" D
- .S @RESULTS@($O(@RESULTS@(""),-1)+1)=@TMP
- S @RESULTS@(0)=$O(@RESULTS@(""),-1)_U_INST
- Q
- ;
- LAST5(RESULTS,PTID) ; [Procedure] Get patients using last 5
- N I,IEN,XREF
- S (I,IEN)=0,XREF=$S($L(PTID)=5:"BS5",1:"BS")
- F S IEN=$O(^DPT(XREF,PTID,IEN)) Q:'IEN D
- .S I=I+1,RESULTS(I)=IEN_U_$P(^DPT(IEN,0),U)_U_$$DOB^DPTLK1(IEN,2)_U_$$SSN^DPTLK1(IEN) ; DG249
- Q
- ;
- LISTALL(RESULTS,FROM,DIR) ; [Procedure] Pt List
- N I,IEN,CNT S CNT=44,I=0
- F S FROM=$O(^DPT("B",FROM),DIR) Q:FROM="" D Q:I=CNT
- .S IEN=0 F S IEN=$O(^DPT("B",FROM,IEN)) Q:'IEN D Q:I=CNT
- ..S I=I+1 S RESULTS(I)=IEN_"^"_FROM
- Q
- ;
- LOGSEC ; [Procedure] Logs secure and restricted record access
- D NOTICE^DGSEC4(.ANRVRET,DFN,DATA,1)
- S @RESULTS@(0)=$S(ANRVRET:"1^Logged",1:"-1^Unable to log")
- Q
- ;
- PINF(RESULTS,PTDFN) ; [Procedure] Patient Information for verification
- N Y,GX,GE,NC,Z,X,I
- D GETS^DIQ(2,+PTDFN,".03;391;1901;.01;.02;.09;.301;.14;","","GX","GE")
- I $D(GE("DIERR",1)) S RESULTS="0^"_GE("DIERR",1,"TEXT",1) Q
- S NC=+PTDFN_",",Z="1^"
- F I=.03,391,1901,.01,.02,.09,.301,.14 D
- .S X=GX(2,NC,I) S Z=Z_X_"^"
- S RESULTS=Z
- Q
- ;
- RPC(RESULTS,OPTION,DFN,DATA) ; [Procedure] Main RPC Call Tag
- S RESULTS=$NA(^TMP($J)) K @RESULTS
- D:$T(@OPTION)]"" @OPTION
- D:'$D(@RESULTS)
- .S @RESULTS@(0)="-1^No results returned"
- D CLEAN^DILF
- Q
- ;
- RPCA(RESULTS,OPTION,ENT,PAR,INST,VAL) ; [Procedure] Main RPC entry
- N ERR,TMP,RET,TXT,IEN,IENS,ROOT
- S INST=$G(INST,1)
- S PAR=$G(PAR,"ANRV")
- S RESULTS=$NA(^TMP($J)) K @RESULTS
- I PAR'?1"ANRV".E S ^TMP($J,0)="-1^Non VIST Outcomes Parameter" Q
- D:$T(@OPTION)]"" @OPTION
- I +$G(ERR) K @RESULTS S @RESULTS@(0)="-1^Error: "_(+ERR)_" "_$P(ERR,U,2)
- I '$D(^TMP($J)) S @RESULTS@(0)="-1^No data returned"
- D CLEAN^DILF
- Q
- ;
- SELECT ; [Procedure] Select Patient
- NEW IENS,ANRVDFN,ANRVFLD,ANRVID,ANRVRET,ANRVX
- I '$D(^DPT(+$G(DFN),0))#2 S @RESULTS@(0)="-1^No such patient" Q
- S @RESULTS@(0)="1^Required Identifiers & messages"
- S IENS=DFN_","
- D FILE^DID(2,,"REQUIRED IDENTIFIERS","ANRVIDS")
- F ANRVX=0:0 S ANRVX=$O(ANRVIDS("REQUIRED IDENTIFIERS",ANRVX)) Q:'ANRVX D
- .S ANRVFLD=ANRVIDS("REQUIRED IDENTIFIERS",ANRVX,"FIELD")
- .S ANRVID="$$PTID^"_$$GET1^DID(2,ANRVFLD,"","LABEL")
- .S ANRVID=ANRVID_U_$$GET1^DIQ(2,IENS,ANRVFLD)
- .D:ANRVFLD=.03
- ..S ANRVID=ANRVID_" ("_$$GET1^DIQ(2,IENS,.033)_")"
- ..S ANRVID=ANRVID_U_$$DOB^DPTLK1(+IENS)
- .D:ANRVFLD=.09
- ..S X=$P(ANRVID,U,3),X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10)
- ..S $P(ANRVID,U,3)=X,$P(ANRVID,U,4)=$$SSN^DPTLK1(+IENS)
- .S @RESULTS@($O(@RESULTS@(""),-1)+1)=ANRVID
- K ANRVRET
- D GUIBS5A^DPTLK6(.ANRVRET,DFN) D:ANRVRET(1)=1
- .D ADD("$$MSGHDR^2^SAME LAST NAME AND LAST 4")
- .S ANRVX=1
- .F S ANRVX=$O(ANRVRET(ANRVX)) Q:'ANRVX!(+$G(ANRVRET(ANRVX))) D
- ..D ADD($P(ANRVRET(ANRVX),U,2))
- .D ADD(" ")
- .S ANRVX=1
- .F S ANRVX=$O(ANRVRET(ANRVX)) Q:'ANRVX D:+ANRVRET(ANRVX)
- ..S ANRVDFN=+$P(ANRVRET(ANRVX),U,2)
- ..D ADD($$GET1^DIQ(2,ANRVDFN_",",.01)_" "_$$DOB^DPTLK1(ANRVDFN)_" "_$$SSN^DPTLK1(ANRVDFN))
- .D ADD(" ")
- .D ADD("Please review carefully before continuing")
- .D ADD("$$MSGEND")
- K ANRVRET
- D PTSEC^DGSEC4(.ANRVRET,DFN) D:ANRVRET(1)'=0
- .D:ANRVRET(1)=3
- ..D ADD("$$MSGHDR^0^CAN'T ACCESS YOUR OWN RECORD!!")
- .D:ANRVRET(1)=-1
- ..D ADD("$$MSGHDR^0^INCOMPLETE INFORMATION - CAN'T PROCEED")
- .D:ANRVRET(1)=1
- ..D ADD("$$MSGHDR^1^SENSITIVE RECORD ACCESS")
- .D:ANRVRET(1)'=-1&(ANRVRET(1)'=3)&(ANRVRET(1)'=1)
- ..D ADD("$$MSGHDR^3^SENSITIVE RECORD ACCESS")
- .S ANRVX=1
- .F S ANRVX=$O(ANRVRET(ANRVX)) Q:'ANRVX D ADD($TR(ANRVRET(ANRVX),"*"," "))
- .D ADD("$$MSGEND")
- D GUIMTD^DPTLK6(.ANRVRET,DFN) D:ANRVRET(1)=1
- .D ADD("$$MSGHDR^1^NOTICE")
- .F ANRVX=1:0 S ANRVX=$O(ANRVRET(ANRVX)) Q:'ANRVX D ADD(ANRVRET(ANRVX))
- .D ADD("$$MSGEND")
- Q
- ;
- SETLST ; [Procedure] Set single value into a parameter
- N ANRVINS ; Instance Counter
- D DELLST(ENT,PAR)
- S ANRVINS=""
- F S ANRVINS=$O(VAL(ANRVINS)) Q:ANRVINS="" D
- .D EN^XPAR(ENT,PAR,ANRVINS,VAL(ANRVINS),.ERR)
- S:'$G(ERR) @RESULTS@(0)="1^List "_PAR_" rebuilt"
- Q
- ;
- SETPAR ; [Procedure] Set single value into a parameter
- D EN^XPAR(ENT,PAR,INST,VAL,.ERR)
- S:'$G(ERR) @RESULTS@(0)="1^Parameter updated"
- Q
- ;
- SETWP ; [Procedure] Set WP text into a parameter
- S TXT=INST,TMP=""
- F S TMP=$O(VAL(TMP)) Q:TMP="" D
- .S TXT($O(TXT(""),-1)+1,0)=VAL(TMP)
- D EN^XPAR(ENT,PAR,INST,.TXT,.ERR)
- S:'$G(ERR) @RESULTS@(0)="1^WP Text Saved"
- Q
- ;
- SIGNON ; [Procedure] Return signon information for user.
- S @RESULTS@(0)=DUZ
- S @RESULTS@(1)=$$GET1^DIQ(200,DUZ_",",.01) ; Name
- S @RESULTS@(2)=+$$FIND1^DIC(4.2,"","QX",$$KSP^XUPARAM("WHERE")) ;Domain
- S @RESULTS@(3)=$$KSP^XUPARAM("WHERE") ; Domain Name
- S @RESULTS@(4)=+$G(DUZ(2)) ; Division IEN
- S @RESULTS@(5)=$S(+$G(DUZ(2)):$$GET1^DIQ(4,DUZ(2)_",",.01),1:"UNKNOWN")
- S @RESULTS@(6)=$$GET1^DIQ(200,DUZ_",",8)
- S @RESULTS@(7)=""
- S @RESULTS@(8)=$G(DTIME,300)
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HANRVOA 7009 printed Feb 19, 2025@00:12:18 Page 2
- ANRVOA ; HOIFO/CED - User, Patient and Parameter specifics for Patient Review. ; [01-07-2003 12:19]
- +1 ;;4.0;VISUAL IMPAIRMENT SERVICE TEAM;**5**;AUG 21, 2003
- ADD(X) ; [Procedure] Adds to RESULTS
- +1 SET @RESULTS@(+$ORDER(@RESULTS@(""),-1)+1)=X
- +2 QUIT
- +3 ;
- DELLST ; [Procedure] Delete list of parameters
- +1 DO NDEL^XPAR(ENT,PAR,.ERR)
- +2 if '$GET(ERR)
- SET @RESULTS@(0)="1^All Instances Removed"
- +3 QUIT
- +4 ;
- DELPAR ; [Procedure] Delete single parameter value
- +1 DO DEL^XPAR(ENT,PAR,INST,.ERR)
- +2 if '$GET(ERR)
- SET @RESULTS@(0)="1^Instance Deleted"
- +3 QUIT
- +4 ;
- ELECSIG ; [Procedure] Check Electronic Signature
- +1 NEW X
- +2 SET X=DATA
- +3 SET X1=$SELECT($DATA(DUZ)[0:"",$DATA(^VA(200,DUZ,20))[0:"",1:$PIECE(^(20),U,4))
- +4 IF X1=""
- SET @RESULTS@(0)="-1^Electronic Signature Not Found."
- QUIT
- +5 DO HASH^XUSHSHP
- +6 IF X1'=X
- SET @RESULTS@(0)="0^Electronic Signature Incorrect."
- QUIT
- +7 SET @RESULTS@(0)="1^Electronic Signature Verified."
- +8 QUIT
- +9 ;
- ENTVAL ; [Procedure] Return value of the entity
- +1 IF ENT="SYS"
- SET ENT=$$KSP^XUPARAM("WHERE")
- +2 IF '$TEST
- IF ENT="DIV"
- SET ENT=$$GET1^DIQ(4,DUZ(2)_",",.01)
- +3 IF '$TEST
- IF ENT="USR"
- SET ENT=$$GET1^DIQ(200,DUZ_",",.01)
- +4 IF '$TEST
- SET ENT=$$GET1^DIQ(+$PIECE(ENT,"(",2),+ENT_",",.01)
- +5 SET @RESULTS@(0)=ENT
- +6 QUIT
- +7 ;
- FULLSSN(LST,ID) ; [Procedure] Return a list of patients matching Full SSN entered
- +1 NEW I,IEN
- +2 SET (I,IEN)=0
- +3 FOR
- SET IEN=$ORDER(^DPT("SSN",ID,IEN))
- if 'IEN
- QUIT
- Begin DoDot:1
- +4 ; DG249
- SET I=I+1
- SET LST(I)=IEN_U_$PIECE(^DPT(IEN,0),U)_U_$$DOB^DPTLK1(IEN,2)_U_$$SSN^DPTLK1(IEN)
- End DoDot:1
- +5 QUIT
- +6 ;
- GETHDR ; [Procedure] Returns common header format
- +1 SET X=$$FIND1^DIC(8989.51,,"QX",PAR)
- +2 IF X
- SET @RESULTS@(0)=X_";8989.51^"_PAR
- +3 IF '$TEST
- SET @RESULTS@(0)="-1^No such parameter ["_PAR_"]"
- +4 QUIT
- +5 ;
- GETLST ; [Procedure] Return all instances of a parameter
- +1 DO GETLST^XPAR(.RET,ENT,PAR,"E",.ERR)
- +2 if $GET(ERR,0)
- QUIT
- +3 SET TMP="RET"
- +4 FOR
- SET TMP=$QUERY(@TMP)
- if TMP=""
- QUIT
- Begin DoDot:1
- +5 SET @RESULTS@($ORDER(@RESULTS@(""),-1)+1)=@TMP
- End DoDot:1
- +6 SET @RESULTS@(0)=$ORDER(@RESULTS@(""),-1)
- +7 QUIT
- +8 ;
- GETPAR ; [Procedure] Returns external value for a parameter
- +1 SET @RESULTS@(0)=$$GET^XPAR(ENT,PAR,INST,"E")
- +2 QUIT
- +3 ;
- GETWP ; [Procedure] Returns WP text for a parameter
- +1 DO GETWP^XPAR(.RET,ENT,PAR,INST,.ERR)
- +2 if $GET(ERR,0)
- QUIT
- +3 SET TMP="RET"
- +4 FOR
- SET TMP=$QUERY(@TMP)
- if TMP=""
- QUIT
- Begin DoDot:1
- +5 SET @RESULTS@($ORDER(@RESULTS@(""),-1)+1)=@TMP
- End DoDot:1
- +6 SET @RESULTS@(0)=$ORDER(@RESULTS@(""),-1)_U_INST
- +7 QUIT
- +8 ;
- LAST5(RESULTS,PTID) ; [Procedure] Get patients using last 5
- +1 NEW I,IEN,XREF
- +2 SET (I,IEN)=0
- SET XREF=$SELECT($LENGTH(PTID)=5:"BS5",1:"BS")
- +3 FOR
- SET IEN=$ORDER(^DPT(XREF,PTID,IEN))
- if 'IEN
- QUIT
- Begin DoDot:1
- +4 ; DG249
- SET I=I+1
- SET RESULTS(I)=IEN_U_$PIECE(^DPT(IEN,0),U)_U_$$DOB^DPTLK1(IEN,2)_U_$$SSN^DPTLK1(IEN)
- End DoDot:1
- +5 QUIT
- +6 ;
- LISTALL(RESULTS,FROM,DIR) ; [Procedure] Pt List
- +1 NEW I,IEN,CNT
- SET CNT=44
- SET I=0
- +2 FOR
- SET FROM=$ORDER(^DPT("B",FROM),DIR)
- if FROM=""
- QUIT
- Begin DoDot:1
- +3 SET IEN=0
- FOR
- SET IEN=$ORDER(^DPT("B",FROM,IEN))
- if 'IEN
- QUIT
- Begin DoDot:2
- +4 SET I=I+1
- SET RESULTS(I)=IEN_"^"_FROM
- End DoDot:2
- if I=CNT
- QUIT
- End DoDot:1
- if I=CNT
- QUIT
- +5 QUIT
- +6 ;
- LOGSEC ; [Procedure] Logs secure and restricted record access
- +1 DO NOTICE^DGSEC4(.ANRVRET,DFN,DATA,1)
- +2 SET @RESULTS@(0)=$SELECT(ANRVRET:"1^Logged",1:"-1^Unable to log")
- +3 QUIT
- +4 ;
- PINF(RESULTS,PTDFN) ; [Procedure] Patient Information for verification
- +1 NEW Y,GX,GE,NC,Z,X,I
- +2 DO GETS^DIQ(2,+PTDFN,".03;391;1901;.01;.02;.09;.301;.14;","","GX","GE")
- +3 IF $DATA(GE("DIERR",1))
- SET RESULTS="0^"_GE("DIERR",1,"TEXT",1)
- QUIT
- +4 SET NC=+PTDFN_","
- SET Z="1^"
- +5 FOR I=.03,391,1901,.01,.02,.09,.301,.14
- Begin DoDot:1
- +6 SET X=GX(2,NC,I)
- SET Z=Z_X_"^"
- End DoDot:1
- +7 SET RESULTS=Z
- +8 QUIT
- +9 ;
- RPC(RESULTS,OPTION,DFN,DATA) ; [Procedure] Main RPC Call Tag
- +1 SET RESULTS=$NAME(^TMP($JOB))
- KILL @RESULTS
- +2 if $TEXT(@OPTION)]""
- DO @OPTION
- +3 if '$DATA(@RESULTS)
- Begin DoDot:1
- +4 SET @RESULTS@(0)="-1^No results returned"
- End DoDot:1
- +5 DO CLEAN^DILF
- +6 QUIT
- +7 ;
- RPCA(RESULTS,OPTION,ENT,PAR,INST,VAL) ; [Procedure] Main RPC entry
- +1 NEW ERR,TMP,RET,TXT,IEN,IENS,ROOT
- +2 SET INST=$GET(INST,1)
- +3 SET PAR=$GET(PAR,"ANRV")
- +4 SET RESULTS=$NAME(^TMP($JOB))
- KILL @RESULTS
- +5 IF PAR'?1"ANRV".E
- SET ^TMP($JOB,0)="-1^Non VIST Outcomes Parameter"
- QUIT
- +6 if $TEXT(@OPTION)]""
- DO @OPTION
- +7 IF +$GET(ERR)
- KILL @RESULTS
- SET @RESULTS@(0)="-1^Error: "_(+ERR)_" "_$PIECE(ERR,U,2)
- +8 IF '$DATA(^TMP($JOB))
- SET @RESULTS@(0)="-1^No data returned"
- +9 DO CLEAN^DILF
- +10 QUIT
- +11 ;
- SELECT ; [Procedure] Select Patient
- +1 NEW IENS,ANRVDFN,ANRVFLD,ANRVID,ANRVRET,ANRVX
- +2 IF '$DATA(^DPT(+$GET(DFN),0))#2
- SET @RESULTS@(0)="-1^No such patient"
- QUIT
- +3 SET @RESULTS@(0)="1^Required Identifiers & messages"
- +4 SET IENS=DFN_","
- +5 DO FILE^DID(2,,"REQUIRED IDENTIFIERS","ANRVIDS")
- +6 FOR ANRVX=0:0
- SET ANRVX=$ORDER(ANRVIDS("REQUIRED IDENTIFIERS",ANRVX))
- if 'ANRVX
- QUIT
- Begin DoDot:1
- +7 SET ANRVFLD=ANRVIDS("REQUIRED IDENTIFIERS",ANRVX,"FIELD")
- +8 SET ANRVID="$$PTID^"_$$GET1^DID(2,ANRVFLD,"","LABEL")
- +9 SET ANRVID=ANRVID_U_$$GET1^DIQ(2,IENS,ANRVFLD)
- +10 if ANRVFLD=.03
- Begin DoDot:2
- +11 SET ANRVID=ANRVID_" ("_$$GET1^DIQ(2,IENS,.033)_")"
- +12 SET ANRVID=ANRVID_U_$$DOB^DPTLK1(+IENS)
- End DoDot:2
- +13 if ANRVFLD=.09
- Begin DoDot:2
- +14 SET X=$PIECE(ANRVID,U,3)
- SET X=$EXTRACT(X,1,3)_"-"_$EXTRACT(X,4,5)_"-"_$EXTRACT(X,6,10)
- +15 SET $PIECE(ANRVID,U,3)=X
- SET $PIECE(ANRVID,U,4)=$$SSN^DPTLK1(+IENS)
- End DoDot:2
- +16 SET @RESULTS@($ORDER(@RESULTS@(""),-1)+1)=ANRVID
- End DoDot:1
- +17 KILL ANRVRET
- +18 DO GUIBS5A^DPTLK6(.ANRVRET,DFN)
- if ANRVRET(1)=1
- Begin DoDot:1
- +19 DO ADD("$$MSGHDR^2^SAME LAST NAME AND LAST 4")
- +20 SET ANRVX=1
- +21 FOR
- SET ANRVX=$ORDER(ANRVRET(ANRVX))
- if 'ANRVX!(+$GET(ANRVRET(ANRVX)))
- QUIT
- Begin DoDot:2
- +22 DO ADD($PIECE(ANRVRET(ANRVX),U,2))
- End DoDot:2
- +23 DO ADD(" ")
- +24 SET ANRVX=1
- +25 FOR
- SET ANRVX=$ORDER(ANRVRET(ANRVX))
- if 'ANRVX
- QUIT
- if +ANRVRET(ANRVX)
- Begin DoDot:2
- +26 SET ANRVDFN=+$PIECE(ANRVRET(ANRVX),U,2)
- +27 DO ADD($$GET1^DIQ(2,ANRVDFN_",",.01)_" "_$$DOB^DPTLK1(ANRVDFN)_" "_$$SSN^DPTLK1(ANRVDFN))
- End DoDot:2
- +28 DO ADD(" ")
- +29 DO ADD("Please review carefully before continuing")
- +30 DO ADD("$$MSGEND")
- End DoDot:1
- +31 KILL ANRVRET
- +32 DO PTSEC^DGSEC4(.ANRVRET,DFN)
- if ANRVRET(1)'=0
- Begin DoDot:1
- +33 if ANRVRET(1)=3
- Begin DoDot:2
- +34 DO ADD("$$MSGHDR^0^CAN'T ACCESS YOUR OWN RECORD!!")
- End DoDot:2
- +35 if ANRVRET(1)=-1
- Begin DoDot:2
- +36 DO ADD("$$MSGHDR^0^INCOMPLETE INFORMATION - CAN'T PROCEED")
- End DoDot:2
- +37 if ANRVRET(1)=1
- Begin DoDot:2
- +38 DO ADD("$$MSGHDR^1^SENSITIVE RECORD ACCESS")
- End DoDot:2
- +39 if ANRVRET(1)'=-1&(ANRVRET(1)'=3)&(ANRVRET(1)'=1)
- Begin DoDot:2
- +40 DO ADD("$$MSGHDR^3^SENSITIVE RECORD ACCESS")
- End DoDot:2
- +41 SET ANRVX=1
- +42 FOR
- SET ANRVX=$ORDER(ANRVRET(ANRVX))
- if 'ANRVX
- QUIT
- DO ADD($TRANSLATE(ANRVRET(ANRVX),"*"," "))
- +43 DO ADD("$$MSGEND")
- End DoDot:1
- +44 DO GUIMTD^DPTLK6(.ANRVRET,DFN)
- if ANRVRET(1)=1
- Begin DoDot:1
- +45 DO ADD("$$MSGHDR^1^NOTICE")
- +46 FOR ANRVX=1:0
- SET ANRVX=$ORDER(ANRVRET(ANRVX))
- if 'ANRVX
- QUIT
- DO ADD(ANRVRET(ANRVX))
- +47 DO ADD("$$MSGEND")
- End DoDot:1
- +48 QUIT
- +49 ;
- SETLST ; [Procedure] Set single value into a parameter
- +1 ; Instance Counter
- NEW ANRVINS
- +2 DO DELLST(ENT,PAR)
- +3 SET ANRVINS=""
- +4 FOR
- SET ANRVINS=$ORDER(VAL(ANRVINS))
- if ANRVINS=""
- QUIT
- Begin DoDot:1
- +5 DO EN^XPAR(ENT,PAR,ANRVINS,VAL(ANRVINS),.ERR)
- End DoDot:1
- +6 if '$GET(ERR)
- SET @RESULTS@(0)="1^List "_PAR_" rebuilt"
- +7 QUIT
- +8 ;
- SETPAR ; [Procedure] Set single value into a parameter
- +1 DO EN^XPAR(ENT,PAR,INST,VAL,.ERR)
- +2 if '$GET(ERR)
- SET @RESULTS@(0)="1^Parameter updated"
- +3 QUIT
- +4 ;
- SETWP ; [Procedure] Set WP text into a parameter
- +1 SET TXT=INST
- SET TMP=""
- +2 FOR
- SET TMP=$ORDER(VAL(TMP))
- if TMP=""
- QUIT
- Begin DoDot:1
- +3 SET TXT($ORDER(TXT(""),-1)+1,0)=VAL(TMP)
- End DoDot:1
- +4 DO EN^XPAR(ENT,PAR,INST,.TXT,.ERR)
- +5 if '$GET(ERR)
- SET @RESULTS@(0)="1^WP Text Saved"
- +6 QUIT
- +7 ;
- SIGNON ; [Procedure] Return signon information for user.
- +1 SET @RESULTS@(0)=DUZ
- +2 ; Name
- SET @RESULTS@(1)=$$GET1^DIQ(200,DUZ_",",.01)
- +3 ;Domain
- SET @RESULTS@(2)=+$$FIND1^DIC(4.2,"","QX",$$KSP^XUPARAM("WHERE"))
- +4 ; Domain Name
- SET @RESULTS@(3)=$$KSP^XUPARAM("WHERE")
- +5 ; Division IEN
- SET @RESULTS@(4)=+$GET(DUZ(2))
- +6 SET @RESULTS@(5)=$SELECT(+$GET(DUZ(2)):$$GET1^DIQ(4,DUZ(2)_",",.01),1:"UNKNOWN")
- +7 SET @RESULTS@(6)=$$GET1^DIQ(200,DUZ_",",8)
- +8 SET @RESULTS@(7)=""
- +9 SET @RESULTS@(8)=$GET(DTIME,300)
- +10 QUIT
- +11 ;