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

APSSINI0.m

Go to the documentation of this file. 
  1. APSSINI0 ;IHS/CIA/MDM - ScriptPro Interface;26-Jun-2008 15:01;DU
  1.  ;;1.0;IHS SCRIPTPRO INTERFACE;**1**;January 11, 2006
  1.  ; APSS COMMAND FILE (#9009033.3) Maintenance & Initialization routine
  1.  ; Direct entry not supported
  1.  Q
  1. EP1 ;MDM - Main entry point
  1.  ;
  1.  ; File structure
  1.  ; APSS COMMAND FILE (#9009033.3)
  1.  ; APSS COMMAND FILE DATA TAG (Multiple-9009033.31)
  1.  ; APSS COMMAND FILE DATA TAG DESCRIPTION (Multiple-9009033.312)
  1.  ;
  1.  ; Variable definitions
  1.  ; APSSDAT = Data
  1.  ; APSSCLC = Comment Line count
  1.  ; APSSTAG = Data Tag (.01)
  1.  ; APSSSEQ = Sequence (.02)
  1.  ; APSSFLD = File/Field (.03)
  1.  ; APSSFMT = Format (.04)
  1.  ; APSSTRAN = Transform (1)
  1.  ; APSSDESC = Description total line number (2)
  1.  ; APSSCMD = Command
  1.  ; APSSSIEN = DATA TAG Subfile IEN
  1.  ; APSSIEN = FDA Array FDA_ROOT Construct
  1.  ; APSSDIEN = DATA TAG DESCRIPTION Sub-Sub File Word Processing field IEN
  1.  ; APSSLINE = Description Text line being processed (Reading data statements)
  1.  ; APSSDEND = Description Text Ending line number (Reading data statements)
  1.  ; APSSDBEG = Description Text Beginning line number (Reading data statements)
  1.  ; ACTION = What action took place (ADD, EDIT, DELETE)
  1.  ; APSSUTAG = Original value that was modified
  1.  ;
  1.  ; Initialize working variables and control cleanup upon routine termination
  1.  N APSSDAT,APSSCLC,APSSTAG,APSSSEQ,APSSFLD,APSSFMT,APSSDESC,APSSTRAN,APSSUTAG
  1.  N APSSCMD,APSSSIEN,APSSIEN,APSSDIEN,FDA,APSSDEND,APSSDBEG,APSSLINE,ACTION
  1.  N ARY,SSEQ
  1.  ;
  1.  ; Grab the IEN for the FILL Command
  1.  S APSSCMD="",APSSCMD=$O(^APSSCOMD("B","FILL",APSSCMD)) Q:'APSSCMD
  1.  S SIEN=0 F  S SIEN=$O(^APSSCOMD(APSSCMD,1,SIEN)) Q:'SIEN  D
  1.  .S SSEQ=$P($G(^APSSCOMD(APSSCMD,1,SIEN,0)),U,2)
  1.  .I SSEQ S ARY(SSEQ)=$P(^APSSCOMD(APSSCMD,1,SIEN,0),U,1)
  1.  ;
  1.  ; MAIN PROCESSING LOOP
  1.  ; Loop through the data statement section of this routine
  1.  F APSSCLC=1:1 S APSSDAT=$P($T(DATA+APSSCLC),";",2) Q:APSSDAT="EOD"  D
  1.  . ; If there is no data on that line quit processing and go get the next line
  1.  . I APSSDAT="" Q
  1.  . ; If the line does not have a "^" in it then it is an invalid record so quit.
  1.  . I APSSDAT'["^" Q
  1.  . ; Piece out the major data elements
  1.  . S APSSTAG=$P(APSSDAT,"^",1)           ; Data Tag
  1.  . S APSSSEQ=$P(APSSDAT,"^",2)           ; Sequence
  1.  . ; if the sequence number is in use and the data tag does not match what is being delivered
  1.  . ; change this sequence number
  1.  . I $D(ARY(APSSSEQ))&($G(ARY(APSSSEQ))'=APSSTAG) S APSSSEQ=$$NEWSEQ(.ARY,APSSSEQ)
  1.  . S APSSFLD=$P(APSSDAT,"^",3)           ; File/Field
  1.  . S APSSFMT=$P($P(APSSDAT,"^",4),"~",1) ; Format
  1.  . S APSSTRAN=$P(APSSDAT,"~",2)          ; Transform
  1.  . S APSSDESC=$P(APSSDAT,"~",3)          ; Description
  1.  . ;
  1.  . ; Filing methods and requirements are determined in this section of code.
  1.  . ;
  1.  . ; *****************************DELETE**************************************
  1.  . ; Check for delete flag and if present, perform appropriate action.
  1.  . I APSSTAG["@",$D(^APSSCOMD(APSSCMD,1,"B",$P(APSSTAG,"@",2))) D  Q
  1.  . . W !,"DELETE RECORD"
  1.  . . S ACTION="DELETE"
  1.  . . ; Grab the IEN for this Data Tag
  1.  . . S APSSSIEN="",APSSSIEN=$O(^APSSCOMD(APSSCMD,1,"B",$P(APSSTAG,"@",2),APSSSIEN))
  1.  . . ; Build FDA Array IEN Construct
  1.  . . S APSSIEN=APSSSIEN_","_APSSCMD_","
  1.  . . ; Build FDA Array to define file structure and field values
  1.  . . S FDA(9009033.31,APSSIEN,.01)="@"
  1.  . . ;
  1.  . . ; Delete this record in the file
  1.  . . D FILE^DIE("","FDA","ERR")
  1.  . . ;
  1.  . . I +$G(ERR("ERR")) D RESET Q
  1.  . . ;
  1.  . . ; Display informational message
  1.  . . D MSG
  1.  . . ; DEVELOPEMENT DISPLAY
  1.  . . ;D DISP
  1.  . . ; Reset working variables
  1.  . . D RESET
  1.  . . ;
  1.  . . Q
  1.  . ;
  1.  . ; *****************************UPDATE***************************************
  1.  . ; If the Umlaut is found in the APSSTAG string then,
  1.  . ; Check for an existing entry and if present, perform appropriate action.
  1.  . ;I APSSTAG["`",$D(^APSSCOMD(APSSCMD,1,"B",$P(APSSTAG,"`",1))) D  Q
  1.  . I $D(^APSSCOMD(APSSCMD,1,"B",APSSTAG)) D  Q
  1.  . . W !,"UPDATE RECORD"
  1.  . . S ACTION="EDIT"
  1.  . . ; Strip off the umlaut character and separate the two values
  1.  . . ; If the DATA TAG value is changing them Piece 2 holds the new value
  1.  . . S APSSUTAG=$P(APSSTAG,"`",2)
  1.  . . ; Piece one holds the current value
  1.  . . S APSSTAG=$P(APSSTAG,"`",1)
  1.  . . ; If piece 1 has no value then
  1.  . . ; Data in another field is changing but the DATA TAG field is not changing
  1.  . . I APSSTAG="" S APSSTAG=APSSUTAG
  1.  . . ; Grab the IEN for this Data Tag
  1.  . . S APSSSIEN="",APSSSIEN=$O(^APSSCOMD(APSSCMD,1,"B",APSSTAG,APSSSIEN))
  1.  . . ; Build FDA Array IEN Construct
  1.  . . S APSSIEN=APSSSIEN_","_APSSCMD_","
  1.  . . ; Build FDA Array
  1.  . . D FDA
  1.  . . ;
  1.  . . ; Update the file
  1.  . . D FILE^DIE("","FDA","ERR")
  1.  . . ;
  1.  . . I +$G(ERR("ERR")) D RESET Q
  1.  . . ;
  1.  . . ; Display informational message
  1.  . . D MSG
  1.  . . ; Process Description Text if defined
  1.  . . D DESC(APSSSIEN)
  1.  . . ; DEVELOPEMENT DISPLAY
  1.  . . ;D DISP
  1.  . . ; Reset working variables
  1.  . . D RESET
  1.  . . Q
  1.  . ;
  1.  . ; **************************NEW ENTRY***************************************
  1.  . ; File a new entry
  1.  . ; Check for an existing entry and if NOT present, perform appropriate action.
  1.  . I '$D(^APSSCOMD(APSSCMD,1,"B",APSSTAG)) D  Q
  1.  . . W !,"RECORD NEW ENTRY"
  1.  . . S ACTION="ADD"
  1.  . . S APSSSIEN="+1"
  1.  . . ; Build FDA Array IEN Construct
  1.  . . S APSSIEN=APSSSIEN_","_APSSCMD_","
  1.  . . ; Build FDA Array
  1.  . . D FDA
  1.  . . ;
  1.  . . ; File the Data
  1.  . . D UPDATE^DIE("","FDA","ERR")
  1.  . . ;
  1.  . . I +$G(ERR("ERR")) D RESET Q
  1.  . . ;
  1.  . . ;Display informational message
  1.  . . D MSG
  1.  . . ; Process Description Text if defined
  1.  . . D DESC(ERR(1))
  1.  . . ; DEVELOPEMENT DISPLAY
  1.  . . ;D DISP
  1.  . . ; Reset working variables
  1.  . . D RESET
  1.  . . Q
  1.  . Q
  1.  ;
  1.  ; Kill the message arrays and variables that are produced by VA FileMan.
  1.  D CLEAN^DILF
  1.  ; End of processing
  1.  Q
  1. DESC(REC) ; Process description text and put it into the file
  1.  ; If there is no description text then quit
  1.  I 'APSSDESC Q
  1.  S APSSIEN=REC_","_APSSCMD_","
  1.  ; Process Description text data statements
  1.  S APSSDEND=APSSCLC+APSSDESC,APSSDBEG=APSSCLC+1  ; Initialize counters
  1.  ; Loop through the description text for this data tag
  1.  F APSSLINE=APSSDBEG:1:APSSDEND S APSSDAT=$P($T(DATA+APSSLINE),";",2) D
  1.  . ; Set up data array t be processed by VA Fileman.
  1.  . S TMP("WP",APSSLINE)=APSSDAT,APSSDAT=""
  1.  . Q
  1.  ;
  1.  ; If Description lines were defined then adjust process looping position
  1.  ; and send the data to VA Fileman to put into the database.
  1.  I APSSLINE S APSSCLC=APSSLINE,APSSLINE="" D
  1.  . ;
  1.  . ; File the description text
  1.  . D WP^DIE(9009033.31,APSSIEN,2,"K","TMP(""WP"")","ERR(""WP"")")
  1.  . Q
  1.  ;
  1.  Q
  1. FDA ;
  1.  ; Build FDA Array to define file structure and field values for use by Fileman
  1.  S FDA(9009033.31,APSSIEN,.01)=APSSTAG
  1.  I $G(APSSUTAG)]"" S FDA(9009033.31,APSSIEN,.01)=APSSUTAG
  1.  S FDA(9009033.31,APSSIEN,.02)=APSSSEQ
  1.  S FDA(9009033.31,APSSIEN,.03)=APSSFLD
  1.  S FDA(9009033.31,APSSIEN,.04)=APSSFMT
  1.  S FDA(9009033.31,APSSIEN,1)=APSSTRAN
  1.  Q
  1. RESET ;
  1.  ; Reset working variables to NULL once each record is processed
  1.  S APSSTAG=""           ; Data Tag
  1.  S APSSSEQ=""           ; Sequence
  1.  S APSSFLD=""           ; File/Field
  1.  S APSSFMT=""           ; Format
  1.  S APSSTRAN=""          ; Transform
  1.  S APSSDESC=""          ; Description
  1.  K TMP,FDA,ERR,ACTION,APSSUTAG
  1.  Q
  1. MSG ; Set up informational messages to display to the screen
  1.  ;
  1.  I '$G(ERR) D
  1.  . I ACTION="ADD" D MES("Data Record: "_APSSTAG_" has been ADDED.")
  1.  . I ACTION="DELETE" D MES("Data Record: "_$P(APSSTAG,"@",2)_" has been DELETED.")
  1.  . I ACTION="EDIT" D MES("Data Record: "_$P(APSSTAG,"`",1)_" has been MODIFIED.")
  1.  . Q
  1.  E  D MES("Data Field: "_APSSTAG_" resulted in ERROR "_ERR(1))
  1.  Q
  1. MES(MSG,QUIT) ; Display informational messages
  1.  D BMES^XPDUTL("  "_$G(MSG))
  1.  Q
  1.  ; INPUT  ARRAY - List of current sequence numbers being used at the facility
  1.  ;           SQ - Sequence number needing to be changed.
  1.  ;
  1. NEWSEQ(ARRAY,SQ) ;
  1.  N OFFSET,QUIT,NSQ
  1.  S QUIT=0,NSQ=SQ
  1.  F OFFSET=.1:.1:.9 D  Q:QUIT
  1.  .S NSQ=$P(SQ,".")+OFFSET
  1.  .I '$D(ARRAY(NSQ)) S QUIT=1 Q
  1.  I 'QUIT S NSQ=SQ+.01
  1.  Q NSQ
  1.  ; *************************************************************************
  1.  ; Structure of data statements found below the DATA line tag.
  1.  ;
  1.  ; DATA TAG^SEQUENCE^FILE,FIELD^FORMAT~TRANSFORM~NUMBER OF DESC. TEXT LINES
  1.  ; NOTE:
  1.  ; If there is a number in the last "~" piece then, there is description text
  1.  ; which may be multiple lines of text. That text will follow the data line
  1.  ; and preceed the next data line. The FOR loop reading the data statements
  1.  ; will be adjusted to skip over the description text. A secondary loop will
  1.  ; read and process the description data.
  1.  ;
  1.  ; To delete a record an "@" must appear as the first character of the data
  1.  ; string.
  1.  ;
  1.  ; To modify a record use the Umlaut "`" as a flag in the first piece of the
  1.  ; data string indicating it is an update.  If the first "^" piece is to be
  1.  ; modified then the NEW value must appear in the SECOND "`" piece.
  1.  ;
  1. DATA ; This module holds the data that will be put into the database.
  1.  ;
  1.  ;Patient Gender^3.2^2,.02^Z~S VAL=$$GET1^DIQ(2,$P(RX0,U,2),.02)~1
  1.  ;Patient Gender Designator
  1.  ;Patient Address^3.3^^Z~S VAL=$$PADDR^APSSLIC($P(RX0,U,2))~1
  1.  ;Patient Address
  1.  ;Provider Class^31^200,53.5^ZR~S VAL=$$GET1^DIQ($S(PARIEN:52.2,REFIEN:52.1,1:52),$S(PARIEN!REFIEN:RXIENS,1:$P(RXIENS,",",$L(RXIENS,",")-1)),$S(PARIEN:6,REFIEN:15,1:4),"I") S:VAL VAL=$$GET1^DIQ(200,VAL,53.5)~1
  1.  ;Provider Class
  1.  ;Provider DEA#^32^200,53.2^ZR~S VAL=$$GET1^DIQ($S(PARIEN:52.2,REFIEN:52.1,1:52),$S(PARIEN!REFIEN:RXIENS,1:$P(RXIENS,",",$L(RXIENS,",")-1)),$S(PARIEN:6,REFIEN:15,1:4),"I") S:VAL VAL=$$GET1^DIQ(200,VAL,53.2)~1
  1.  ;Provider DEA#
  1.  ;Site DEA#^33^^Z~S VAL=$$SDEA^APSSLIC($P(RX0,U,5))~1
  1.  ;Site DEA#
  1.  ;Site Name^34^^Z~S VAL=$$SNAME^APSSLIC($P(RX0,U,5))~1
  1.  ;Site Name
  1.  ;Issue Date^35^52,1^Z~S VAL=$$FMTE^XLFDT($P(RX0,U,13),"5Z")~1
  1.  ;Issue Date
  1.  ;Login Date^37^52,21^Z~S VAL=$$FMTE^XLFDT($P(RX2,U),"5Z")~1
  1.  ;Login Date
  1.  ;License Number^36^200.541,1^ZR~S VAL=$$EP1^APSSLIC($$GET1^DIQ($S(PARIEN:52.2,REFIEN:52.1,1:52),$S(PARIEN!REFIEN:RXIENS,1:$P(RXIENS,",",$L(RXIENS,",")-1)),$S(PARIEN:6,REFIEN:15,1:4),"I"),2)~17
  1.  ;Provider License Number
  1.  ;
  1.  ; Parameter 1 passed to APSSLIC routine represents the Provider Internal Entry Number
  1.  ; Paramneter 2 represents the processing method which is described below..
  1.  ;
  1.  ; Method 1
  1.  ; Match it to the state the facility is in
  1.  ; If there is no license for that state then return any valid license
  1.  ; If no valid license found for any state then return NULL
  1.  ;
  1.  ; Method 2
  1.  ; There is no license for the state the facility is in then,
  1.  ; return NULL even if other states have a valid license defined.
  1.  ;
  1.  ; Method 3
  1.  ; Return first valid license found regardless of state
  1.  ; No valid license found, then return NULL
  1.  ;
  1.  ;EOD
  1.  Q