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

YTAPI8.m

Go to the documentation of this file.
  1. YTAPI8 ;ASF/ALB- ASI PROCEEDURES ;7/26/01 11:35
  1. ;;5.01;MENTAL HEALTH;**67,71**;Dec 30, 1994
  1. ADDER(YSDATA) ;add new record
  1. N DIC,DLAYGO,X,Y
  1. S DLAYGO=604,DIC(0)="L",DIC="^YSTX(604,",X="NEW"
  1. D ^DIC
  1. I Y'>0 S YSDATA(1)="[ERROR]",YSDATA(2)=-1 Q ;->out
  1. S YSDATA(1)="[DATA]",YSDATA(2)=+Y
  1. Q
  1. ;GET ASI STORED DATA
  1. GETASI(YSDATA,YS) ;NEEDS IEN FOR FILE 604,DFN
  1. ;Field #^Question^Required^Answer
  1. N YSIEN,DFN,G,N,N1,X,YSN
  1. S YSIEN=$G(YS("IEN"))
  1. S DFN=$G(YS("DFN"))
  1. I YSIEN'>0!('$D(^YSTX(604,YSIEN))) S YSDATA(1)="[ERROR]",YSDATA(2)="BAD IEN" Q ; --->
  1. I $P(^YSTX(604,YSIEN,0),U,2)'=DFN S YSDATA(1)="[ERROR]",YSDATA(2)="BAD DFN MATCH" Q ;--->OUT
  1. S YSDATA(1)="[DATA]"
  1. S YSDATA(2)=.02_U_"NAME"_U_1_U_$$GET1^DIQ(604,YSIEN_",",.02,"E")
  1. S YSDATA(3)=.51_U_"ELECTRONICALLY SIGNED"_U_1_U_$$GET1^DIQ(604,YSIEN_",",.51,"E")
  1. S YSN=3
  1. DCROSS S N=0
  1. F S N=$O(^YSTX(604.66,"D",N)) Q:N'>0 D
  1. . S N1=$O(^YSTX(604.66,"D",N,0))
  1. . S G=^YSTX(604.66,N1,0)
  1. . S X=$$GET1^DIQ(604,YSIEN_",",N,"E")
  1. . S YSN=YSN+1
  1. . S YSDATA(YSN)=N_U_$P(G,U,2)_U_$P(G,U,8)_U_X
  1. Q
  1. LISTASI(YSDATA,YS) ;ASI LISTER
  1. ;REQUIRES: DFN
  1. ;RETURNS: IEN^DATE OF INTERVIEW^CLASS^SPECIAL^ESIGNED
  1. ;0 RETURNED IF NO ADMINS
  1. N DFN,YSIEN,YSN
  1. S DFN=$G(YS("DFN"))
  1. I DFN<1 S YSDATA(1)="[ERROR]",YSDATA(2)="BAD DFN" Q ;--->OUT
  1. S YSDATA(1)="[DATA]",YSDATA(2)=0
  1. S YSN=1
  1. S YSIEN=0
  1. F S YSIEN=$O(^YSTX(604,"C",DFN,YSIEN)) Q:YSIEN'>0 D
  1. . S YSN=YSN+1
  1. . S YSDATA(YSN)=YSIEN_U_$$FMTE^XLFDT($$GET1^DIQ(604,YSIEN_",",.05,"I"),"5ZD")_U_$$GET1^DIQ(604,YSIEN_",",.04,"E")_U_$$GET1^DIQ(604,YSIEN_",",.11,"E")_U_$$GET1^DIQ(604,YSIEN_",",.51,"E")_U_$$GET1^DIQ(604,YSIEN_",",.09,"E")
  1. Q
  1. SIGNOK(YSDATA,YSIEN) ; all reqiured fields
  1. ;ysflag 1= ok 0= missing 2=SPECIAL
  1. N N1,YSASCLS,X,YSASFLD,YSF,YSASSPL,YSN,YSFLAG
  1. S YSFLAG=1
  1. I '$D(^YSTX(604,YSIEN,0)) S YSDATA(1)="[ERROR]",YSDATA(2)="BAD IEN" Q
  1. S YSDATA(1)="[DATA]",YSDATA(2)="1^OK TO SIGN"
  1. S YSN=2
  1. S YSASCLS=$$GET1^DIQ(604,YSIEN_",",.04,"I")
  1. S YSASCLS=YSASCLS+3
  1. S N1=0 F S N1=$O(^YSTX(604.66,N1)) Q:N1'>0 D:($P(^YSTX(604.66,N1,0),U,8)&($P(^YSTX(604.66,N1,0),U,YSASCLS)))
  1. . S YSASFLD=$P(^YSTX(604.66,N1,0),U,3)
  1. . D TYPE
  1. .; S YSF=$S(YSASFLD>10.02&(YSASFLD<10.44):"I",$P(^DD(604,YSASFLD,0),U,2)?1"P".E:"",1:"I")
  1. . S YSF=$S(YSASFLD>10.02&(YSASFLD<10.44):"I",YSTYPE=1:"",1:"I")
  1. . S X=$$GET1^DIQ(604,YSIEN,YSASFLD,YSF)
  1. . S:X="" YSFLAG=0,YSN=YSN+1,YSDATA(YSN)=^YSTX(604,66,N1,0)
  1. S X=$$GET1^DIQ(604,YSIEN,YSASFLD,.11)
  1. S:X="X"!(X="N") YSFLAG=2
  1. S:YSFLAG=0 YSDATA(2)="0^MISSING REQUIRED FIELDS"
  1. S:YSFLAG=2 YSDATA(2)="2^A G12 RECORD"
  1. Q
  1. TYPE ;check field type
  1. ;O = NOT A POINTER 1 = POINTER
  1. N YSFLD,YSTYPE
  1. S YSTYPE=0
  1. D FIELD^DID(604,YSASFLD,"","TYPE","YSFLD")
  1. S:YSFLD("TYPE")="POINTER" YSTYPE=1
  1. Q
  1. SIGN(YSDATA,YS) ; API for /es/
  1. N YSCODE,YSASINTV,YSASTRS,VALID
  1. S YSCODE=$G(YS("CODE"))
  1. I YSCODE="" S YSDATA(1)="[ERROR]",YSDATA(2)="NO SIG SENT" Q
  1. S YSIEN=$G(YS("YSIEN"))
  1. I YSIEN'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="NO REC NUMBER" Q
  1. I '$D(^YSTX(604,YSIEN)) S YSDATA(1)="[ERROR]",YSDATA(2)="NO REC FOUND" Q
  1. S VALID=$$VALIDATE($$DECRYP^XUSRB1(YSCODE))
  1. I +VALID'>0 S YSDATA(1)="[DATA]",YSDATA(2)="0^Bad EScode, not signed" Q
  1. S YSASINTV=$$GET1^DIQ(604,YSIEN_",",.09,"I") ;INTERVERER
  1. S YSASTRS=$$GET1^DIQ(604,YSIEN_",",.14,"I") ;TRANSCRIBER
  1. I YSASINTV=DUZ,DUZ>0 D Q ;---> OUT
  1. . D CR^YSASCR(YSIEN,YSASINTV,"")
  1. . S YSDATA(1)="[DATA]",YSDATA(2)="1^ASI SIGNED"
  1. I YSASTRS=DUZ,DUZ>0 D Q ;---> OUT
  1. . D CONV^YSASCR(YSIEN,YSASINTV)
  1. . D BUL^YSASBUL(YSIEN,YSASTRS,YSASINTV)
  1. . S YSDATA(1)="[DATA]",YSDATA(2)="0^TRANSCRIBER SEND BULLETIN"
  1. S YSDATA(1)="[ERROR]",YSDATA(2)="BAD LOGIC"
  1. Q
  1. VALIDATE(X) ; Validate /es/-code
  1. N YSY S YSY=0
  1. D HASH^XUSHSHP I X]"",(X=$P($G(^VA(200,+DUZ,20)),U,4)) S YSY=1
  1. Q YSY