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

DVBACPR1.m

Go to the documentation of this file.
  1. DVBACPR1 ;ALB/GAK - PATCH DVBA*2.7*189 introduced field utility RPCs;April 14, 2023 ; 5/16/23 11:59am
  1. ;;2.7;AMIE;**189,248**;Apr 10, 1995;Build 6
  1. ; This routine provides list, get and set features for several CAPRI RPCs
  1. Q
  1. ;
  1. LSTCT(RTRN) ;
  1. ;LIST VALID CLAIM TYPES
  1. ;RPC: DVBA CAPRI LISTCLAIMTYPE
  1. N CTIEN,CODE,CTR
  1. K ^TEMP($J,"LSTCT")
  1. S CTIEN=0
  1. F S CTIEN=$O(^DVB(396.27,CTIEN)) Q:CTIEN=""!('CTIEN) D
  1. . Q:$G(^DVB(396.27,CTIEN,0))=""
  1. . S ^TEMP($J,"LSTCT",$P(^DVB(396.27,CTIEN,0),"^",1))=CTIEN
  1. S CODE="",CTR=0
  1. F S CODE=$O(^TEMP($J,"LSTCT",CODE)) Q:CODE="" D
  1. . S CTR=CTR+1
  1. . S RTRN(CTR)=CODE_"^"_^TEMP($J,"LSTCT",CODE)
  1. K ^TEMP($J,"LSTCT")
  1. Q
  1. ;
  1. GETCT(RTRN,REQIEN) ;
  1. ;GET CLAIM TYPE
  1. ;RPC: DVBA CAPRI GETCLAIMTYPE
  1. I $G(REQIEN)="" S RTRN(1)="INVALID REQUEST IEN" Q
  1. I '$D(^DVB(396.3,$G(REQIEN))) S RTRN(1)="INVALID REQUEST IEN" Q
  1. N MSG,ERR,CTR,MSGIEN,FIND,OUT
  1. D GETS^DIQ(396.3,REQIEN_",","9.1*","E","MSG","ERR")
  1. I $D(ERR)>1 S RTRN(1)="NO CLAIM TYPE ON FILE" Q
  1. S CTR=0
  1. S MSGIEN="" F S MSGIEN=$O(MSG(396.32,MSGIEN)) Q:MSGIEN="" D
  1. . S CTR=CTR+1
  1. . K FIND,OUT
  1. . S FIND=MSG(396.32,MSGIEN,.01,"E")
  1. . D FIND^DIC(396.27,"",.01,"",.FIND,"","","","","OUT")
  1. . S RTRN(CTR)=MSG(396.32,MSGIEN,.01,"E")_"^"_$G(OUT("DILIST",2,1))
  1. Q
  1. ;
  1. SETCT(RTRN,REQIEN,ARRAYCT) ;
  1. ;SET CLAIM TYPE
  1. ;RPC: DVBA CAPRI SETCLAIMTYPE
  1. ;
  1. N VAL,SUB,DA,DIK
  1. S VAL="" F S VAL=$O(^DVB(396.3,REQIEN,9,"B",VAL)) Q:VAL="" D
  1. . S SUB="" F S SUB=$O(^DVB(396.3,REQIEN,9,"B",VAL,SUB)) Q:SUB="" D
  1. .. K DA,DIK
  1. .. S DA(1)=REQIEN
  1. .. S DA=SUB
  1. .. S DIK="^DVB(396.3,"_DA(1)_",""9"","
  1. .. D ^DIK
  1. ;
  1. I $G(REQIEN)="" S RTRN(1)="INVALID REQUEST IEN" Q
  1. I '$D(^DVB(396.3,$G(REQIEN))) S RTRN(1)="INVALID EXAM IEN" Q
  1. N ARYIEN,CTR,FDA,ERR,KEYIEN,FIND
  1. S CTR=0
  1. S ARYIEN="" F S ARYIEN=$O(ARRAYCT(ARYIEN)) Q:ARYIEN="" D
  1. . S CTR=CTR+1
  1. . K FIND,OUT
  1. . S FIND=ARRAYCT(ARYIEN)
  1. . D FIND^DIC(396.27,"",.01,"",.FIND,"","","","","OUT")
  1. . I $G(OUT("DILIST",2,1))="" S RTRN(CTR)=FIND_"^"_"NOT A VALID CLAIM TYPE" Q
  1. . K FDA,ERR,KEYIEN
  1. . S KEYIEN=OUT("DILIST",2,1)
  1. . S FDA(396.32,"+2,"_REQIEN_",",.01)=KEYIEN
  1. . D UPDATE^DIE("","FDA","KEYIEN","ERR")
  1. . I $D(ERR)>1 S RTRN(CTR)=FIND_"^"_"COULD NOT BE FILED" Q
  1. . S RTRN(CTR)=FIND_"^"_"FILED"
  1. ;
  1. Q
  1. ;
  1. LSTSC(RTRN) ;
  1. ;LIST SPECIAL CONSIDERATION
  1. ;RPC: DVBA CAPRI LISTSPCLCONSID
  1. N SCIEN,CTR,CODE
  1. K ^TEMP($J,"LSTSC")
  1. S SCIEN=0
  1. F S SCIEN=$O(^DVB(396.25,SCIEN)) Q:SCIEN=""!('SCIEN) D
  1. . Q:$G(^DVB(396.25,SCIEN,0))=""
  1. . Q:$P($G(^DVB(396.25,SCIEN,0)),U,2)'=1
  1. . S ^TEMP($J,"LSTSC",$P(^DVB(396.25,SCIEN,0),"^",1))=SCIEN
  1. S CODE="",CTR=0
  1. F S CODE=$O(^TEMP($J,"LSTSC",CODE)) Q:CODE="" D
  1. . S CTR=CTR+1
  1. . S RTRN(CTR)=CODE_"^"_^TEMP($J,"LSTSC",CODE)
  1. K ^TEMP($J,"LSTSC")
  1. Q
  1. ;
  1. GETSC(RTRN,REQIEN) ;
  1. ;GET SPECIAL CONSIDERATION
  1. ;RPC: DVBA CAPRI GETSPCLCONSID
  1. I $G(REQIEN)="" S RTRN(1)="INVALID REQUEST IEN" Q
  1. I '$D(^DVB(396.3,$G(REQIEN))) S RTRN(1)="INVALID REQUEST IEN" Q
  1. N MSG,ERR,CTR,MSGIEN,FIND,OUT
  1. D GETS^DIQ(396.3,REQIEN_",","50*","E","MSG","ERR")
  1. I $D(ERR)>1 S RTRN(1)="NO SPECIAL CONSIDERATIONS ON FILE" Q
  1. S CTR=0
  1. S MSGIEN="" F S MSGIEN=$O(MSG(396.31,MSGIEN)) Q:MSGIEN="" D
  1. . S CTR=CTR+1
  1. . K FIND,OUT
  1. . S FIND=MSG(396.31,MSGIEN,.01,"E")
  1. . D FIND^DIC(396.25,"",.01,"",.FIND,"","","","","OUT")
  1. . S RTRN(CTR)=MSG(396.31,MSGIEN,.01,"E")_"^"_$G(OUT("DILIST",2,1))
  1. Q
  1. ;
  1. SETSC(RTRN,REQIEN,ARRAYSC) ;
  1. ;SET SPECIAL CONSIDERATION
  1. ;RPC: DVBA CAPRI SETSPCLCONSID
  1. ;
  1. N VAL,SUB,DA,DIK
  1. S VAL="" F S VAL=$O(^DVB(396.3,REQIEN,8,"B",VAL)) Q:VAL="" D
  1. . S SUB="" F S SUB=$O(^DVB(396.3,REQIEN,8,"B",VAL,SUB)) Q:SUB="" D
  1. .. K DA,DIK
  1. .. S DA(1)=REQIEN
  1. .. S DA=SUB
  1. .. S DIK="^DVB(396.3,"_DA(1)_",""8"","
  1. .. D ^DIK
  1. ;
  1. I $G(REQIEN)="" S RTRN(1)="INVALID REQUEST IEN" Q
  1. I '$D(^DVB(396.3,$G(REQIEN))) S RTRN(1)="INVALID REQUEST IEN" Q
  1. N ARYIEN,CTR,FDA,ERR,KEYIEN,FIND
  1. S CTR=0
  1. S ARYIEN="" F S ARYIEN=$O(ARRAYSC(ARYIEN)) Q:ARYIEN="" D
  1. . S CTR=CTR+1
  1. . K FIND,OUT
  1. . S FIND=ARRAYSC(ARYIEN)
  1. . D FIND^DIC(396.25,"",.01,"",.FIND,"","","","","OUT")
  1. . I $G(OUT("DILIST",2,1))="" S RTRN(CTR)=FIND_"^"_"NOT A VALID SPECIAL CONSIDERATION" Q
  1. . K FDA,ERR,KEYIEN
  1. . S KEYIEN=OUT("DILIST",2,1)
  1. . S FDA(396.31,"+2,"_REQIEN_",",.01)=KEYIEN
  1. . D UPDATE^DIE("","FDA","KEYIEN","ERR")
  1. . I $D(ERR)>1 S RTRN(CTR)=FIND_"^"_"COULD NOT BE FILED" Q
  1. . S RTRN(CTR)=FIND_"^"_"FILED"
  1. ;
  1. Q
  1. ;
  1. LSTIR(RTRN) ;
  1. ;LIST INSUFFICIENT REASON
  1. ;RPC: DVBA CAPRI LISTINSUFRSN
  1. ;FILE #396.4 FIELD .11 --> FILE #396.94
  1. ;BUILD LIST OF VALID (ACTIVE) REASONS
  1. N IRIEN,CTR,CODE
  1. K ^TEMP($J,"LSTIR")
  1. S IRIEN=0
  1. F S IRIEN=$O(^DVB(396.94,IRIEN)) Q:IRIEN=""!('IRIEN) D
  1. . Q:$G(^DVB(396.94,IRIEN,0))=""
  1. . Q:$P(^DVB(396.94,IRIEN,0),"^",4)="Y"
  1. . S ^TEMP($J,"LSTIR",$P(^DVB(396.94,IRIEN,0),"^",1))=IRIEN
  1. S CODE="",CTR=0
  1. F S CODE=$O(^TEMP($J,"LSTIR",CODE)) Q:CODE="" D
  1. . S CTR=CTR+1
  1. . S RTRN(CTR)=CODE_"^"_^TEMP($J,"LSTIR",CODE)
  1. Q
  1. ;